动画“飞出”，为何添加声音无效？

chuhaiou

Sub 飞出()
Set shp = ActiveWindow.Selection.ShapeRange(1)

With ActivePresentation.Slides(1).TimeLine.MainSequence.AddEffect(Shape:=shp, effectid:=2)
.Exit = 1
shp.AnimationSettings.SoundEffect.Name = "风铃"
End With
End Sub


动画“飞出”，为何添加"风铃"声音无效？没加上，但又不提示错误，是什么回事？而手动添加"风铃"声音又能加上。

leikaiyi123

经测试，vba不能直接为飞出添加声音，可先设置为飞入并添加飞入声音，再改为飞出。

详见下面ppt2003测试代码：
Sub 添加飞入动画和声音() '飞入＋声音
    Dim oshp As Shape
    Set oshp = ActiveWindow.Selection.ShapeRange(1)
    With ActivePresentation.Slides(1).TimeLine.MainSequence.AddEffect(Shape:=oshp, effectid:=2)
        .Exit = 0    '0飞入，1飞出
        .EffectInformation.SoundEffect.Name = "风铃"   '飞入可同时添加声音，飞出则不行
        'oshp.AnimationSettings.SoundEffect.Name = "风铃"
    End With
End Sub
Sub 添加飞出动画和声音()    '声音和飞出不能同时改，只能在飞入中改，再改为飞出
    Dim oshp As Shape
    Set oshp = ActiveWindow.Selection.ShapeRange(1)
    With ActivePresentation.Slides(1).TimeLine.MainSequence.AddEffect(Shape:=oshp, effectid:=2)
        .Exit = 0    '0飞入，1飞出  '先添加飞入，****此处设飞出时，添加不了声音，用SoundEffect.ImportFromFile也不行
        .EffectInformation.SoundEffect.Name = "抽气" '再设置飞入的声音，后面修改为飞出后即为飞出的声音
    End With
    'oshp.AnimationSettings.SoundEffect.Name = "抽气" '也可用此法设置飞入的声音
    ActiveWindow.Selection.SlideRange.TimeLine.MainSequence.FindFirstAnimationFor(Shape:=oshp).Exit = 1 '再修改为飞出(此行不会修改已有声音)
End Sub
Sub 修改飞入动画为飞出并改声音()    '须先改飞入声音，再改为飞出，若顺序交换(先改为了飞出)则改不了声音，即飞入是什么声音则飞出就是什么声音，飞入没有声音则改不了飞出声音
    Dim oshp As Shape
    Set oshp = ActiveWindow.Selection.ShapeRange(1)
    oshp.AnimationSettings.SoundEffect.Name = "抽气"    '"风铃" '先直接修改飞入的声音
    'ActiveWindow.Selection.SlideRange.TimeLine.MainSequence.FindFirstAnimationFor(Shape:=oshp).EffectInformation.SoundEffect.Name = "抽气"  '此法也行
    ActiveWindow.Selection.SlideRange.TimeLine.MainSequence.FindFirstAnimationFor(Shape:=oshp).Exit = 1    '再修改为飞出即可(此行不会修改已有声音)
End Sub

Sub 批量修改选定页的进入动画为退出并添加退出声音() '
    'On Error Resume Next
    Dim oeffect As Effect
    For Each oeffect In ActiveWindow.Selection.SlideRange.TimeLine.MainSequence    '在主序列时间线循环查找动作
        oeffect.EffectInformation.SoundEffect.Name = "风铃"    '触发时间居然会变，后面再修改，也可忽略
        'oeffect.Exit = 1'居然声音和退出不能同时修改，只能先后批量改
    Next
   
    For Each oeffect In ActiveWindow.Selection.SlideRange.TimeLine.MainSequence    '在主序列时间线循环查找动作
        If oeffect.Timing.TriggerType = msoAnimTriggerAfterPrevious Then oeffect.Timing.TriggerType = msoAnimTriggerWithPrevious  '改启动动画的触发器“上一动画之后”为“与上一动画同时”
        'oeffect.EffectInformation.SoundEffect.Name = "风铃"
        oeffect.Exit = 1 '退出
    Next
End Sub

chuhaiou

leikaiyi123 发表于 2019-6-2 22:04
经测试，vba不能直接为飞出添加声音，可先设置为飞入并添加飞入声音，再改为飞出。

详见下面ppt2003测试 ...

Sub 批量修改选定页的进入动画为退出并添加退出声音() '比较好，但是又会删除全面的动画效果