How to restart macro in PowerPoint VBA by changing slides

Question

I am creating a timer in PowerPoint VBA and I would like it to restart when the user presses back on the remote control. For this, I used this sub:

Private Sub PPTEvent_SlideShowBegin(ByVal Wn As SlideShowWindow)
    Call Tmr
End Sub

But nothing happens when I press back (or left arrow key). I would also like the macro to start when I open the PowerPoint document and I thought that would have been done by a Sub Auto_Open() command, placed in a module. Nope.

I would be crazy happy for a tiny bit of help!

Answer 1

I am not sure which verion you are using. You might like to try one of these events, OnSlideShowPageChange for example.

Answer 2

That is a great idea!

Unfortunately, I didn't get it to work. I've placed everything inside a Module like this:

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public restart As Boolean

Public Sub OnSlideShowPageChange(ByVal Wn As SlideShowWindow)
    If Wn.View.CurrentShowPosition = _
        Wn.Presentation.SlideShowSettings.StartingSlide Then
          restart = True
    End If
End Sub

Sub Tmr()

    Dim startS As Integer
    Dim startM As Integer
    Dim textToShow As String
    restart = False

    'On Slide 1, Shape 1 is the textbox
    With ActivePresentation.Slides(1)
        With .Shapes(1)
            .TextFrame.TextRange.Font.Color = RGB(0, 220, 0)
            startS = Second(Time)
            startM = Minute(Time)

            Do While (True) 
                If restart Then
                    .TextFrame.TextRange.Font.Color = RGB(0, 220, 0)
                    startS = Second(Time)
                    startM = Minute(Time)
                End If

                ' Suspend  program execution for 1 second (1000 milliseconds)
                Sleep 1000

                textToShow = TimeSerial(Hour(Now), Minute(Now) - startM, Second(Now) - startS)

                'Changes the colour on the timer from green to red after 5s
                If Second(Now) - startS > 5 Then
                    .TextFrame.TextRange.Font.Color = RGB(240, 0, 0)
                End If

                .TextFrame.TextRange.Text = Right(textToShow, 5)

                DoEvents                
            Loop
        End With
    End
    End With
End Sub

And since I didn't get OnSlideBegin either, I placed a transparent button over the sheet. So I start the slideshow, click the button, timer starts and all, but when I use the arrow keys, nothing at all happens. It doesn't even get to the end of the slide. Do you have any idea what to change?

//Jenny