倒计时宏代码

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