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