PowerPoint Countdown Timer Macro

While working at Curtiss-Wright, I was assigned the task of creating a PowerPoint slideshow that contained a countdown timer to the shipment date of a major project that we could show off to visiting clients. Oddly enough, after scouring the internet in search of a function that would count down to a specific date and time, I discovered that nothing like that existed without downloading questionable software that was not approved by IT.

I didn't believe it, either.

After researching for an hour or so, I knew I needed to cut my losses and write my own macro for the presentation. So, I set to work, learning Visual Basic for Applications (VBA) and studied similar code strings to get it done.

I labored over the code for three to five hours before generating a usable macro. After another two or three hours of troubleshooting, the macro was good to go.

This is what the timer looked like in the presentation:

Here it is now for any other technical writers looking to wow their bosses:

Note: I wrote the code out twice. The first version is the uninterrupted code in full; the second has inserted explanations of what's going on so it can be changed as needed.

---

Public Declare Sub Sleep Lib "kernel 32" (Byl/al dwMilliseconds As Long)

Sub Countdown ()

Dim thedate As Date

Dim daycount As Long

Dim hourcount As Long

Dim minutecount As Long

Dim secondcount As Long

Dim secondtime As Long

Dim minutetime As Long

Dim hourtime As Long

thedate = "10/03/2019"

secondcount = DateDiff("s", Now, thedate) - 1

Sleep 1000

xtime = Now

Do While (secondcount > 0)

'seconds

minutecount = DateDiff("n", Now, thedate) - 1

secondcount = DateDiff("s", Now, thedate) - 1

secondtime = secondcount - (minutecount*60)

ActivePresentation.Slides(17).Shapes(8). TextFrame.TextRange

=secondtime & Chr(10) & "Seconds"

'minutes

minutecount = DateDiff("n", Now, thedate) - 1

hourcount = DateDiff("h", Now, thedate) - 1

minutetime = minutecount - (hourcount*60)

ActivePresentation.Slides(17).Shapes(7). TextFrame.TextRange

=minutetime & Chr(10) & "Minutes"

'hours

hourcount = DateDiff("h", Now, thedate) - 1

daycount = DateDiff("d", Now, thedate) - 1

hourtime = hourcount - (daycount*24)

ActivePresentation.Slides(17).Shapes(6). TextFrame.TextRange

=hourtime & Chr(10) & "Hours"

'days

daycount = DateDiff("d", Now, thedate) - 1

ActivePresentation.Slides(17).Shapes(5). TextFrame.TextRange

=daycount & Chr(10) & "Days"

DoEvents

Loop

End

End Sub

---

Clear as mud? Let me break it down. For the most part, my explanation will be added as green text preceded by an apostrophe, as apostrophes precede note text that the macro will ignore when running.

Public Declare Sub Sleep Lib "kernel 32" (Byl/al dwMilliseconds As Long)

'This opens the macro sequence and tells it when to start. It also tells it

how frequently to run. Because it's set to count milliseconds, it should run

every time the specified number of milliseconds passes.

Sub Countdown ()

'This tells the macro that these are its instructions.

Dim thedate As Date

Dim daycount As Long

Dim hourcount As Long

Dim minutecount As Long

Dim secondcount As Long

Dim secondtime As Long

Dim minutetime As Long

Dim hourtime As Long

'These are the main variables that the macro will be using. "As Date"

and "As Long" determine the type of variable format.

thedate = "10/03/2019"

'This is the date that the original slideshow counted down to. Replace

it with a date that hasn't happened yet.

secondcount = DateDiff("s", Now, thedate) - 1

'This gives it the initial value of the seconds until the date.

Sleep 1000

'This specifies that the loop should run every 1000 milliseconds (1

second.)

xtime = Now

'This gives the macro a time to compare against, i.e. now.

Do While (secondcount > 0)

'This tells the macro to run while there are still seconds remaining.

'seconds

'This is a comment to mark where the seconds information begins.

minutecount = DateDiff("n", Now, thedate) - 1

secondcount = DateDiff("s", Now, thedate) - 1

secondtime = secondcount - (minutecount*60)

'The second value should be equal to one second less than the

number of minutes to ensure that it shows the remaining time

rather than total seconds until the date.

ActivePresentation.Slides(17).Shapes(8). TextFrame.TextRange

=secondtime & Chr(10) & "Seconds"

'This tells it where to put the values. Replace "17" with the slide

where the countdown should go and "8" with the nth shape on

screen where you want the seconds time to be recorded.

'minutes

minutecount = DateDiff("n", Now, thedate) - 1

hourcount = DateDiff("h", Now, thedate) - 1

minutetime = minutecount - (hourcount*60)

ActivePresentation.Slides(17).Shapes(7). TextFrame.TextRange

=minutetime & Chr(10) & "Minutes"

'hours

hourcount = DateDiff("h", Now, thedate) - 1

daycount = DateDiff("d", Now, thedate) - 1

hourtime = hourcount - (daycount*24)

ActivePresentation.Slides(17).Shapes(6). TextFrame.TextRange

=hourtime & Chr(10) & "Hours"

'days

daycount = DateDiff("d", Now, thedate) - 1

'Because we want the number of days until the date to reflect

the total rather than remainder, there are fewer calculations

needed.

ActivePresentation.Slides(17).Shapes(5). TextFrame.TextRange

=daycount & Chr(10) & "Days"

DoEvents

'Tells the macro to function.

Loop

'Tells the macro to repeat until parameters specified.

End

'Tells the macro to end once parameters reached.

End Sub

'Tells the macro that there's nothing else for it to read.