PowerPoint - Create Countdown Timer - VBA

Question

I am working on a project where we want to have a countdown timer that is displayed on a slide for while students are completing a project.

I have found multiple examples online, however when trying to adapt them for our purpose, I cannot get the code to run as expected.

In my testing, I have added breakpoints to the code as well as debug.prints to try and see if it is executing the code or not so that I can step through to see if there is any logic errors. However, when I play the slideshow, while it does not appear to hit a breakpoint, it does do the first update line -- ActivePresentation.Slides(1).Shapes("MainTitle").TextFrame.TextRange.Text = "Got To " & Now

I just cannot figure out how to get it to countdown properly.

Your thoughts and guidance would be greatly appreciated.

Public Sub BAR01_Countdown()

ActivePresentation.Slides(1).Shapes("MainTitle").TextFrame.TextRange.Text = "Got To " & Now

Dim CountTimeEnd As Date
Dim myHours As Integer
Dim myMinutes As Integer
Dim mySeconds As Integer
Dim dispH As Integer
Dim dispM As Integer
Dim dispS As Integer
Dim dispTime As String
Dim secondsRemain As Integer

    CountTimeEnd = Now()
    myHours = 0
    myMinutes = 5
    mySeconds = 0

    CountTimeEnd = DateAdd("h", myHours, CountTimeEnd)
    CountTimeEnd = DateAdd("n", myMinutes, CountTimeEnd)
    CountTimeEnd = DateAdd("s", mySeconds, CountTimeEnd)


    Do Until CountTimeEnd < Now()
        secondsRemain = (DateDiff("s", CountTimeEnd, Now))
        
        dispH = Round((secondsRemain) / (60 * 60), 0)
        dispM = Round(((secondsRemain) - (dispH * 60 * 60)) / 60, 0)
        dispS = (secondsRemain) - (dispH * 60 * 60) - (dispM * 60)
        
        If dispH > 0 Then
            dispTime = Format(dispH, "00") & " : " & Format(dispM, "00") & " . " & Format(dispS, "00")
        ElseIf dispH < 0 And dispM > 0 Then
            dispTime = Format(dispM, "00") & " . " & Format(dispS, "00")
        Else
            dispTime = Format(dispS, "00") & " seconds"
        End If
        
        ActivePresentation.Slides(1).Shapes("MainTitle").TextFrame.TextRange.Text = dispTime
        DoEvents
    Loop

End Sub

Sub OnSlideShowPageChange()
        BAR01_Countdown
End Sub

Answer 1

I have PowerPoint 2010, and according to the Help file, the DateAdd argument for minutes should be "n", not "m", so

CountTimeEnd = DateAdd("n", myMinutes, CountTimeEnd)

should work. I made some modifications to your loop, this should do the trick:

CountTimeEnd = Now()
myHours = 0
myMinutes = 5
mySeconds = 0

CountTimeEnd = DateAdd("h", myHours, CountTimeEnd)
CountTimeEnd = DateAdd("n", myMinutes, CountTimeEnd)
CountTimeEnd = DateAdd("s", mySeconds, CountTimeEnd)


Do Until CountTimeEnd < Now()
    secondsRemain = (DateDiff("s", Now, CountTimeEnd))
    
    dispH = Int(secondsRemain / (60 * 60))
    dispM = Int(secondsRemain / 60) Mod 60
    dispS = secondsRemain Mod 60
    
    If dispH > 0 Then
        dispTime = Format(dispH, "00") & " : " & Format(dispM, "00") & " . " & Format(dispS, "00")
    ElseIf dispM > 0 Then
        dispTime = Format(dispM, "00") & " . " & Format(dispS, "00")
    Else
        dispTime = Format(dispS, "00") & " seconds"
    End If
    
    ActivePresentation.Slides(1).Shapes("MainTitle").TextFrame.TextRange.Text = dispTime
    DoEvents
Loop

Answer 2

Well, the good news is that it could be done without any line of code. However, it will take more than a click to be done (guaranteed to work).

1. Navigate to the first slide of your presentation.

2. Click the Insert tab of the Ribbon, then click Video > Video on My PC (or Video from File in other PPT versions).

3. Well, this is the most important step. You have to choose a video showing the countdown that you want. But from where to get this video ? No problem, from YouTube! If you want a countdown of 5 minutes, just type in YT countdown 5 min, and you'll get a bunch of useful videos. Same technique applies if your countdown is of 41 minutes. Next, you will download the video and for this just add ss before youtube.com in the URL of the video. You will be redirected to savefrom.net where you can directly download your video. After storing the video in your PC, choose it to insert it in you presentation (you may need to repeat step 2).

4. Now, your video appears in the first slide. Don't forget that you can always Resize and Reposition your video countdown ; for instance you may resize it and drag it to the top right corner.

5. Next, select your video, click on Playback Tab (Video Tools Playback) on the Ribbon. Click the Start drop-down list, choose Automatically. In fact, you set your video countdown to play automatically.

6. Click the Animations tab of the Ribbon, then click the Animation Pane button.

7. Within the resultant Animation Pane that shows up (on the right), double-click the first animation; this will bring up the Play Video dialog box.

8. In the Play Video dialog box, select the Effect tab. In the Stop Playing section, click on After radio button and set the value to 999 - the max value (your presentation won't exceed 999 slides, I'm pretty sure :p). Click finally Ok.

And that's it !! Congratulations, you're finally done. Now what you can do is to click on Slide Show and you'll see your countdown timer showing a reduced amount of time as you progress from slide to slide.