Simulate a countdown timer using Sleep API 

This example simulates a countdown and then jumps on to the second slide. It makes use of the Sleep API to suspend the macro execution for an interval of 1 second. 

To run this example , Insert two autoshapes onto the 1st slide. Set the action settings of the 2nd autoshape to run macro Tmr. Start the show, the click click on the autoshape, it runs the Tmr Macro which simulates the countdown (interval specified) and upon completion moves on to the next slide 

Note: In the Slide Transition Window of the Slide, which contains the "timer" textbox, both the Advance options have been unchecked. This prevents the slide from advancing due to an accidental mouse click

' --------------------------------------------------------------------------------
' Copyright ©1999-2007, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' --------------------------------------------------------------------------------

Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub Tmr()

'Just in the eventuality that you click the start button twice
'isRunning stores the current state of the macro
'TRUE = Running; FALSE = Idle

Static isRunning As Boolean
If isRunning = True Then
    End
Else
    isRunning = True
    Dim TMinus As Integer
    Dim xtime As Date
    xtime = Now

    'On Slide 1, Shape 1 is the textbox

    With ActivePresentation.Slides(1)
        .Shapes(2).TextFrame.TextRange.Text = "Ladies & Gentlemen." & vbCrLf & _
            "Please be seated. We are about to begin."
        With .Shapes(1)

    'Countdown in seconds   

    TMinus = 120 

    Do While (TMinus > -1)

           ' Suspend  program execution for 1 second (1000 milliseconds)

            Sleep 1000

            xtime = Now
           .TextFrame.TextRange.Text = Format(TimeValue(Format(Now, "hh:mm:ss")) - _                                TimeSerial(Hour(Now), Minute(Now), Second(Now) + TMinus), "hh:mm:ss")

            TMinus = TMinus - 1

             ' Very crucial else the display won't refresh itself

            DoEvents
            Loop
    End With

    ' 3-2-1-0 Blast off and move to the next slide or any slide for that matter

    SlideShowWindows(1).View.GotoSlide (2)
    isRunning = False
    .Shapes(2).TextFrame.TextRange.Text = "Click here to start countdown"
    End
       
    End With
End If

End Sub

Using SetTimer/KillTimer API in PowerPoint 2000 

PowerPoint 2000 supports the new AddressOf keyword. This lets you call a specific Windows API function in your code and pass to it the address of a procedure in your project that you want that API function to call. This keyword allows us to make calls to a whole range of API calls which were otherwise unusable. Care should be taken that your VBA routine is so designed to receive exactly the same type and number of arguments as the API function expects to send to it. If not you can be sure that a lot of GPF's and hair pulling will follow. So lets learn how to make use of the AddressOf while calling the SetTimer API. The SetTimer API let's us specify the time interval and we need to specify the procedure to be invoked when the time interval has elapsed. We do so using the AddressOf operator. TimerProc is the procedure that we desire to invoke after 1 second has elapsed hence the statement.

SetTimer(0, 0, 1000, AddressOf TimerProc)

KillTimer API is used to terminate the Timer using the TimerID obtained while creating the timer using SetTimer call.

Top

' --------------------------------------------------------------------------------
' Copyright ©1999-2007, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' --------------------------------------------------------------------------------

Option Explicit

'API Declarations

Declare Function SetTimer Lib "user32" _
                            (ByVal hwnd As Long, _
                             ByVal nIDEvent As Long, _
                             ByVal uElapse As Long, _
                             ByVal lpTimerFunc As Long) As Long

Declare Function KillTimer Lib "user32" _
                            (ByVal hwnd As Long, _
                             ByVal nIDEvent As Long) As Long

' Public Variables 

Public SecondCtr As Integer 
Public TimerID As Long
Public bTimerState As Boolean

Sub TimerOnOff()

If bTimerState = False Then
    TimerID = SetTimer(0, 0, 1000, AddressOf TimerProc)
    If TimerID = 0 Then
        MsgBox "Unable to create the timer", vbCritical + vbOKOnly, "Error"
        Exit Sub
    End If
    bTimerState = True
Else    
    TimerID = KillTimer(0, TimerID)
    If TimerID = 0 Then
        MsgBox "Unable to stop the timer", vbCritical + vbOKOnly, "Error"
    End If
    bTimerState = False
End If
End Sub

' The defined routine gets called every nnnn milliseconds.

Sub TimerProc(ByVal hwnd As Long, _
                    ByVal uMsg As Long, _
                    ByVal idEvent As Long, _
                    ByVal dwTime As Long)

SecondCtr = SecondCtr + 1
ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange.Text = CStr(SecondCtr)

End Sub

Top