Как запустить код VBA, когда открывается слайд PowerPoint?

Question

Я использую PowerPoint 2016.

На этом форуме я нашел другие вопросы (например, здесь ), которые указывают, что ответом является использование событий OnSlideShowPageChange или slideshownextslide.Однако мне кажется, что эти события не происходят.

У меня есть следующий код в модуле в моей презентации

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

Но я даже никогда не вижу этот первый msgBox "здесь" .... Есть идеи, где я ошибаюсь?

Файл, который я использую, находится здесь .Пытался вставить несколько текстовых полей и комментарии к коду, чтобы было понятно, что я собираюсь сделать

Answer 1

Здесь было окончательное решение после всей помощи, которую я получил здесь ...

Option Explicit

Public Function Pause(NumberOfSeconds As Variant)

'credit to /6697191/sroki-zaderzhki-v-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

У вас есть некоторые ошибки компиляции.В редакторе VB выберите Отладка > Скомпилируйте VBAProject , и вы увидите, что:

Next shp: Далее без For.

Измените два экземпляра End на End If.

---

РЕДАКТ. :

1. На основефайл предоставлен, есть ошибка во время выполнения.MsgBox "slideshow index is " & sld.SlideIndex приходит до Set sld = ....Переключите порядок двух.

2. Кроме того, измените Set sld = Application.ActiveWindow.View.Slide на Set sld = ActivePresentation.SlideShowWindow.View.Slide

3. Обратите внимание, что поиск InStr выполняется с учетом регистра.чувствительный по умолчанию.Измените InStr(1, boxText, "10 Seconds") на InStr(1, boxText, "10 seconds") или просто InStr(boxText, "10 seconds"), поскольку вы используете строчные "секунды".

4. Возможно, вы захотите переместить shp.TextFrame.TextRange.Text = "10 seconds" после Next iчтобы убедиться, что текст shp сброшен.В ходе тестирования презентация закончилась до того, как текст мог быть сброшен на последнем слайде.Код можно настроить для обработки случая последнего слайда и следовать исходному подходу для всех остальных слайдов.

---

Полный код :

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