Why does a countdown timer freeze when placed in SlideMaster?

Question

I used the following code to have a Countdown which would span over 10 slides whilst in slideshow mode. I placed the shapes in a SlideMaster Layout.

Set QS = ActivePresentation.Designs(2).SlideMaster.CustomLayouts(2)
Dim Seconds As Integer
Seconds = 30
QS.Shapes("Counter").TextFrame.TextRange = Seconds

For i = 1 To 30
   Dim WAIT As Double
   WAIT = Timer
   While Timer < WAIT + 1
        DoEvents  
   Wend
        Seconds = Seconds - 1
        QS.Shapes("Counter").TextFrame.TextRange = Seconds
Next i

Dim time As Date
Dim count As Integer

time = Now()
count = 30

time = DateAdd("s", count, time)

Do Until time < Now
DoEvents

With ActivePresentation.Designs(2).SlideMaster.CustomLayouts(2).Shapes("Counter").TextFrame.TextRange
.Text = Format((time - Now()), "hh:mm:ss")
End With
Loop

Both the codes work properly if they are not placed in SlideMaster Layout.

Are there any better means to have a countdown that spans across multiple slides?

Answer 1

There is a better way to show a countdown by using the Format (Now(), "hh:mm:ss")

To create a countdown we need two values:

1. The current time
2. The future time when the countdown expires

Dim time As Date
Dim count As Integer

time = Now() 'the current time
count = 30
time = DateAdd("s", count, time) 'the future time after 30 seconds

The above gives us the two values.

Now, we can make a loop to change the text inside the Counter shape.

Do Until time < Now() 'We change text until the present time passes the set "future time"
DoEvents

For i = 1 To 10 'Assuming you want the countdown in slides 1 To 10
   With ActivePresentation.Slides(i).Shapes("countdown").TextFrame.TextRange
   .Text = Format((time - Now()), "hh:mm:ss")
   End With
Next i

Loop

You can use this to have a countdown across multiples slides.