How can I run VBA code when a PowerPoint slide opens

Question

I'm using PowerPoint 2016.

I have found other questions on this forum (like here) that indicate the answer is to use the OnSlideShowPageChange or slideshownextslide events. However, it seems to me that these events do not fire.

I have the following code in a module in my presentation

Public Sub OnSlideShowPageChange(ByVal Wn As SlideShowWindow)

    Dim i As Integer
    Dim sld As Slide
    Dim shp As Shape
    Dim boxText As String

     MsgBox "here"

    Set sld = Application.ActiveWindow.View.Slide
    'If Wn.View.CurrentShowPosition = 5 Then
    If sld.SlideIndex = 5 Then


        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                MsgBox "looking"
                boxText = shp.TextFrame.TextRange.Text
                If InStr(1, boxText, "10 Seconds") <> 0 Then  'we found the countdown box
                    For i = 1 To 10
                        Pause (1)
                        If i < 9 Then
                            shp.TextFrame.TextRange.Text = 10 - i & " seconds"
                        Else
                            shp.TextFrame.TextRange.Text = 10 - i & " second"
                        End If
                    Next i
                End
            End
        Next shp

    ActivePresentation.SlideShowWindow.View.Next
    shp.TextFrame.TextRange.Text = "10 seconds"


   End If
End Sub

But I never even see that first msgBox "here"....any idea where I'm going wrong?

The file I'm using is located here. Tried to put in some text boxes and code comments to make it clear what I'm looking to do

Answer 1

Here was the final solution after all the help I got here...

Option Explicit

Public Function Pause(NumberOfSeconds As Variant)

'credit to https://stackoverflow.com/questions/6960434/timing-delays-in-vba#_=_

    On Error GoTo Error_GoTo

    Dim PauseTime As Variant
    Dim Start As Variant
    Dim Elapsed As Variant

    PauseTime = NumberOfSeconds
    Start = Timer
    Elapsed = 0
    Do While Timer < Start + PauseTime
        Elapsed = Elapsed + 1
        If Timer = 0 Then
            ' Crossing midnight
            PauseTime = PauseTime - Elapsed
            Start = 0
            Elapsed = 0
        End If
        DoEvents
    Loop

Exit_GoTo:
    On Error GoTo 0
    Exit Function
Error_GoTo:
    Debug.Print Err.Number, Err.Description, Erl
    GoTo Exit_GoTo
End Function

Public Sub OnSlideShowPageChange(ByVal Wn As SlideShowWindow)

    Dim i As Integer
    Dim sld As Slide
    Dim shp As Shape
    Dim boxText As String
    Dim IsThisAQuestionSlide As Boolean

    IsThisAQuestionSlide = False

    Set sld = ActivePresentation.SlideShowWindow.View.Slide

    Select Case sld.SlideIndex
        Case 5: IsThisAQuestionSlide = True
        ' all the slide index #'s of question slides go here
    End Select


    If IsThisAQuestionSlide = True Then
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                boxText = shp.TextFrame.TextRange.Text
                If InStr(boxText, "10 Seconds") <> 0 Then  'we found the countdown box
                    For i = 1 To 10
                        Pause (1)
                        If i < 9 Then
                            shp.TextFrame.TextRange.Text = 10 - i & " Seconds"
                        Else
                            shp.TextFrame.TextRange.Text = 10 - i & " Second"
                        End If
                    Next i
                    shp.TextFrame.TextRange.Text = "10 Seconds"
                End If
            End If
        Next shp

        ActivePresentation.SlideShowWindow.View.Next

   End If
End Sub

Answer 2

You've got some compile errors. In the VB editor, select Debug > Compile VBAProject and you'll see that:

Next shp: Next without For.

Change the two instances of End to End If.

---

EDIT:

1. Based on the file provided, there's a run-time error. MsgBox "slideshow index is " & sld.SlideIndex comes before Set sld = .... Switch the order of the two.

2. Additionally, change Set sld = Application.ActiveWindow.View.Slide to Set sld = ActivePresentation.SlideShowWindow.View.Slide

3. Note that InStr search is case-sensitive by default. Change InStr(1, boxText, "10 Seconds") to InStr(1, boxText, "10 seconds"), or just InStr(boxText, "10 seconds"), since you are using lowercase "seconds".

4. You might want to move the shp.TextFrame.TextRange.Text = "10 seconds" to after Next i to ensure that the shp text is reset. In testing, the presentation ended before the text could be reset on the last slide. The code could be tweaked to handle the case of the last slide and follow your original approach for all other slides.

---

Full code:

Public Sub OnSlideShowPageChange(ByVal Wn As SlideShowWindow)

    Dim i As Integer
    Dim sld As Slide
    Dim shp As Shape
    Dim boxText As String

    Set sld = ActivePresentation.SlideShowWindow.View.Slide
    MsgBox "slideshow index is " & sld.SlideIndex

    If sld.SlideIndex = 5 Then
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                boxText = shp.TextFrame.TextRange.Text
                If InStr(boxText, "10 seconds") <> 0 Then  'we found the countdown box
                    For i = 1 To 10
                        Pause (1)
                        If i < 9 Then
                            shp.TextFrame.TextRange.Text = 10 - i & " seconds"
                        Else
                            shp.TextFrame.TextRange.Text = 10 - i & " second"
                        End If
                    Next i

                    shp.TextFrame.TextRange.Text = "10 seconds"
                End If
            End If
        Next shp

        ActivePresentation.SlideShowWindow.View.Next
   End If
End Sub