|
|
经测试，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 |
|
