Link to home
Create AccountLog in
Avatar of Thomas_Meyer
Thomas_MeyerFlag for Czechia

asked on

Edit Timer in VBA

Hi,

 Can you help me finish the timer in PowerPoint? I need to make my remaining time on each slide show, now I see just the first.
Do you have any way to do this?

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
ExitFlag = False
Static isRunning As Boolean
If isRunning = True Then
    End
Else
    isRunning = True
    Dim TMinus As Integer
    Dim xtime As Date
    xtime = Now

    With ActivePresentation.Slides(2).Shapes("Timer")

    'Countdown in seconds
    TMinus = 59

    Do While (TMinus > -1)
    DoEvents
        ' Rather crude way to determine if a second has elapsed
        If ExitFlag = True Then
            .TextFrame.TextRange.Text = "00:00:00"
            isRunning = False
            Exit Sub
        End If
        If Format(Now, "ss") <> Format(xtime, "ss") Then
            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
            ' Let the display refresh itself
        End If
    Loop
    End With
    Debug.Print "came here"
    isRunning = False
    StopQuiz True
    End
End If
End Sub

Open in new window

Avatar of Chris Bottomley
Chris Bottomley
Flag of United Kingdom of Great Britain and Northern Ireland image

Do you mean you have multiple presentations with the same structure and the text needs updating on each?  If so then how about:

Chris
Sub Tmr()
dim pres as variant
'Just in the eventuality that you click the start button twice
'isRunning stores the current state of the macro
'TRUE = Running; FALSE = Idle
ExitFlag = False
Static isRunning As Boolean
If isRunning = True Then
    End
Else
    isRunning = True
    Dim TMinus As Integer
    Dim xtime As Date
    xtime = Now

    for each pres in appplication.presentations
        With pres.Slides(2).Shapes("Timer")

            'Countdown in seconds
            TMinus = 59
            Do While (TMinus > -1)
                DoEvents
                ' Rather crude way to determine if a second has elapsed
                If ExitFlag = True Then
                    .TextFrame.TextRange.Text = "00:00:00"
                    isRunning = False
                    Exit Sub
                End If
                If Format(Now, "ss") <> Format(xtime, "ss") Then
                    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
                    ' Let the display refresh itself
                End If
            Loop
        End With
        Debug.Print "came here"
        isRunning = False
        StopQuiz True
        End
    End If
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Chris Bottomley
Chris Bottomley
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
Have you considered disabling the button in the button's click event?  It might simplify your coding requirements.