时间戳

首页 > 解决方案 > 使用 VBA 在 PowerPoint 中的特定幻灯片上淡出背景媒体的音量

vba - 使用 VBA 在 PowerPoint 中的特定幻灯片上淡出背景媒体的音量

问题描述

我有一个以自动播放媒体文件开头的 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

标签： vbapowerpoint

解决方案

这几乎行得通，但 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

推荐阅读