VBA를 사용하여 PowerPoint의 특정 슬라이드에서 배경 미디어 볼륨 페이드

Question

자동으로 재생되는 미디어 파일로 시작하는 PowerPoint가 있습니다. 첫 번째 슬라이드는 음악이 계속 재생되는 동안 20 초 후에 전환되도록 프로그래밍되어 있습니다. 슬라이드 쇼가 진행되는 동안 계속 재생하고 싶지만 두 번째 슬라이드가 나타나면 볼륨을 낮추고 나머지 프레젠테이션 동안 그대로 유지하고 싶습니다. 이 Powerpoint 변경 사운드 효과 볼륨을 매크로로 보았지만 내 요구를 충족시키지 못하는 것 같습니다.

나는 이것을 시도했다 :

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

운이 없습니다. 생각?

다음은 최신 편집 내용입니다 (여전히 작동하지 않음).

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

이것은 거의 작동하지만 PPT는 결국 우리를 격추시킵니다. 실행 후 사운드 파일의 볼륨이 줄어들지 만 슬라이드 쇼 중에 변경되지 않습니다 .

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