Creating a Break Timer in PowerPoint using VBA

When I teach live classes, I use the SysInternals Zoomit application, which has a break timer built in. However, I was teaching a online class, and Zoomit did not seem to get along with WebEx. I decided to write a break timer directly into the PowerPoint slides I was using.

The first step is to create a slide at the end of the presentation that looks like this:

In other words, it is a standard slide with a title at the top and bullet points section below. I centered both and removed the bullet, so it just had text on the time. The code below counts on this slide as being the last in the presentation.

Next I brought up the PowerPoint Visual Basic Editor. You can do this with Alt+F11. Insert a module with Insert > Module from the menu. In the module, add this VBA code:

Option Explicit

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As Long)
Private lngPreviousSlide As Long
Private boolEndBreak As Boolean

Public Sub BreakTimer()
    Dim dtmStart As Date
    Dim dtmEnd As Date
    Dim slidesCollection As slides
    Dim slideBreak As slide
    Dim lngCurrentSlide As Long
   
    dtmStart = Now
    dtmEnd = DateAdd("n", 10, dtmStart)
   
    Set slidesCollection = Application.ActivePresentation.slides
    Set slideBreak = slidesCollection(slidesCollection.Count)
   
    lngCurrentSlide = SlideShowWindows(1).View.slide.SlideIndex
    If lngCurrentSlide = slidesCollection.Count Then
        'On the break slide, end the break early
        boolEndBreak = True
    Else
        ' Go on break
        lngPreviousSlide = lngCurrentSlide
        boolEndBreak = False
        SlideShowWindows(1).View.GotoSlide slidesCollection.Count, msoTrue
        DoEvents
        Do Until (Now > dtmEnd) Or boolEndBreak
            slideBreak.Shapes(2).TextFrame.TextRange.Text = Format(dtmEnd - Now, "n:ss")
            Sleep 900
            DoEvents
        Loop
        SlideShowWindows(1).View.GotoSlide lngPreviousSlide, msoFalse
    End If
End Sub

When this code run, it remembers the current slide, changes the code to the last slide, and starts a 10 minute countdown (Change the 10 in the DateAdd function to another number to do a different number of minutes in your break).

I then went to the master slide (View > Slide Master) and added a small button in the lower right hand corner. To add a button, you need to have the Developer ribbon turned on. Use File > Options > Customize Ribbon and check the checkbox next to Developer in the dialog and press OK. Then switch to your Developer ribbon.

On the Developer ribbon, Click the Command Button icon, then draw the button on the master slide. Then click the Properties button on the ribbon. Set the name of the button to cmdBreak, and select a clock type image file in the Picture property by hitting the ... button on the right. Then double-click on the button you just created. This creates an Event Handler for the button. In the Event Handler, add this code:

Option Explicit

Private Sub cmdBreak_Click()
    Call BreakTimer
End Sub

Close the Master slide. Run your presentation. Whenever you want to call a break, click the button in the lower right of the current slide. It will jump to your break slide and start counting down. At the end of the break, it will jump back to the slide it was on. If you want to end the break early, on the break slide, click the break button and it will end it (the code is re-entrant, so it can be processing and the button is hit again, which executes it a second time while the first instance is still running).