Verblassen des Volumens von Hintergrundmedien auf einer bestimmten Folie in PowerPoint mithilfe von VBA

Nov 19 2020

Ich habe ein PowerPoint, das mit einer Mediendatei beginnt, die automatisch abgespielt wird. Die erste Folie ist so programmiert, dass sie nach 20 Sekunden wechselt, während die Musik weiter abgespielt wird. Ich möchte, dass es für die Dauer der Diashow weiter abgespielt wird, aber nach dem Erscheinen der zweiten Folie auf eine geringere Lautstärke zurückgeht und für den Rest der Präsentation so bleibt. Ich habe mir diese Lautstärke für Powerpoint-Soundeffekte im Makro angesehen, aber sie scheint meine Anforderungen nicht zu erfüllen.

Ich habe es versucht:

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

Ohne Glück. Gedanken?

Hier ist die neueste Bearbeitung (immer noch kein Glück, dass sie funktioniert):

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

Antworten

SteveRindsberg Nov 27 2020 at 19:55

Das funktioniert fast , aber PPT schießt uns am Ende nieder. Nach der Ausführung wurde die Lautstärke der Audiodatei verringert, sie ändert sich jedoch während der Diashow nicht.

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