Zmniejsz głośność mediów w tle na określonym slajdzie w programie PowerPoint za pomocą VBA

Question

Mam program PowerPoint, który zaczyna się od automatycznego odtwarzania pliku multimedialnego. Pierwszy slajd jest zaprogramowany na przejście po 20 sekundach, podczas gdy muzyka jest odtwarzana. Chciałbym, aby był odtwarzany przez cały czas trwania pokazu slajdów, ale zmniejszał głośność po pojawieniu się drugiego slajdu i pozostawał taki do końca prezentacji. Patrzyłem na ten efekt dźwiękowy Powerpoint zmieniający głośność w makro, ale wydaje się, że nie spełnia moich potrzeb.

Próbowałem tego:

Sub fadeVolSlideChange(ByVal ShowPos As SlideShowWindow)
    Dim ShowPos As Integer
    Dim bkgMusic As Shape
    Dim Step As Long
    
    ShowPos = ShowPos.View.CurrentShowPosition
    Set bkgMusic = ActiveWindow.Selection.ShapeRange(1)

    If ShowPos = 2 Then
        Set Step = 0.05
        For i = 1 To 0.5
            With bkgMusic.MediaFormat
                .Volume = i
                .Muted = False
            End With
            i = i - Step
            Application.Wait (Now + 0.0000025)
        Next i
    End If

End Sub

Bez szczęścia. Myśli?

Oto najnowsza zmiana (nadal nie udało się jej uruchomić):

Sub OnSlideShowPageChange()
    Dim i As Integer
    Dim bkgMusic As Shape
    Dim bkgVol As Long
    Dim inc As Long
    i = ActivePresentation.SlideShowWindow.View.CurrentShowPosition
    Set bkgMusic = ActivePresentation.Slides(1).Shapes("Opening Theme")
    
    If i = 1 Then
        'Do nothing
    ElseIf i <> 1 Then
        inc = 0.05
        For bkgVol = 1 To 0.1
            With bkgMusic.MediaFormat
                .Volume = bkgVol
                .Muted = False
            End With
            bkgVol = bkgVol - inc
            Application.Wait (Now + TimeValue("0:00:01"))
        Next bkgVol
    End If
    
End Sub

Answer 1

To prawie działa, ale PPT w końcu nas strzela. Po uruchomieniu głośność pliku dźwiękowego została zmniejszona, ale nie zmienia się podczas pokazu slajdów.

Sub OnSlideShowPageChange()
    Dim i As Integer
    Dim bkgMusic As Shape
    ' This needs to be single, not Long
    Dim bkgVol As Single
    Dim inc As Long
    Dim lCounter As Long
    
    i = ActivePresentation.SlideShowWindow.View.CurrentShowPosition

    Set bkgMusic = ActivePresentation.Slides(1).Shapes("Opening Theme")
    
    If i = 2 Then
        inc = 0.05
        ' Changing the value by fractions so must be a single, not a long, and
        ' decreasing the value requires Step and a negative number:
        For bkgVol = 1 To 0.1 Step -0.1
            With bkgMusic.MediaFormat
                .Volume = bkgVol
                .Muted = False
            End With
            'bkgVol = bkgVol - inc
            ' Application.Wait is not supported in PPT
            'Application.Wait (Now + TimeValue("0:00:01"))
            WaitForIt
            SlideShowWindows(1).View.GotoSlide (2)
        Next bkgVol
    End If
    
End Sub


Sub WaitForIt()

Dim x As Long

For x = 1 To 1000000
    DoEvents
Next
    'MsgBox "Done waiting"
End Sub