如何使用 VBA 管理 PowerPoint 书签并根据它们触发效果?
How to manage PowerPoint Bookmarks and trigger effects based on them using VBA?
我要添加音频书签和
将它们关联到 VBA.
中 Timing 对象的 TriggerBookmark 属性
要添加书签,此功能可以完成工作:
Function AddBookMark(ByRef MediaObject As Shape, ByVal PositionInMs As Long, ByVal BookMarkName As String) As MediaBookmark
Dim Result As MediaBookmark
With MediaObject
Set Result = .MediaFormat.MediaBookmarks.Add(Position:=PositionInMs, name:=BookMarkName)
End With
Set AddBookMark = Result
End Function
下面这段代码
- 添加媒体对象
- 向该媒体对象添加 2 个书签
- 添加一个矩形形状
- 创建并影响 AnimationBehaviour
动画有效,但我想根据创建的书签启动动画效果。
2 条注释行不起作用。
有人明白为什么吗?
Sub SetBookMarkAsTriggerTest()
FileName = "C:\path\to\your.mp3"
Dim Slide As Slide
Dim MediaObject As Shape
Dim AnimatedShape As Shape
Dim FirstBookMark As MediaBookmark
Dim SecondBookMark As MediaBookmark
Dim FirstEffect As Effect
Dim SecondEffect As Effect
Dim Behaviour As AnimationBehavior
Set Slide = ActivePresentation.Slides(1)
Set MediaObject = Slide.shapes.AddMediaObject2(FileName, msoTrue,_
msoTrue, 50, 50)
MediaObject.name = "MediaOBject1"
Set FirstBookMark = AddBookMark(MediaObject, 5000, "bm1")
Set SecondBookMark = AddBookMark(MediaObject, 7000, "bm2")
Set AnimatedShape = Slide.shapes.addShape(msoShapeRectangle, _
0, 0, 100, 50)
Set FirstEffect = Slide.TimeLine.MainSequence.AddEffect(Shape:=AnimatedShape, _
EffectId:=msoAnimEffectFade, Trigger:=msoAnimTriggerAfterPrevious)
FirstEffect.Timing.Duration = 10
Set Behaviour = FirstEffect.Behaviors.Add(msoAnimTypeMotion)
With Behaviour
With .motionEffect
.FromX = 0
.FromX = 0
.ToX = 50
.ToY = 50
End With
With .Timing
.Duration = 2
'this line does not work...why ?
'.TriggerType = msoAnimTriggerOnMediaBookmark
'this line does not work neither...why ?
'.TriggerBookmark = "bm1"
End With
End With
End Sub
非常感谢!
我设法通过使用 InteractiveSequences 完成了我想做的事情。
然后我们可以根据书签使用 AddTriggerEffect 方法添加触发效果如下:
Function AddBookMark(ByRef MediaObject As Shape, ByVal PositionInMs As Long, ByVal BookMarkName As String) As MediaBookmark
Dim result As MediaBookmark
With MediaObject
Set result = .MediaFormat.MediaBookmarks.Add(Position:=PositionInMs, Name:=BookMarkName)
End With
Set AddBookMark = result
End Function
Sub SetBookMarkAsTriggerTest()
fileName = "C:\path\to\your.mp3"
Dim Slide As Slide
Dim MediaObject As Shape
Dim AnimatedShape As Shape
Dim FirstBookMark As MediaBookmark
Dim FirstEffect As effect
Dim Behaviour As AnimationBehavior
Set Slide = ActivePresentation.Slides(1)
Set MediaObject = Slide.shapes.AddMediaObject2(fileName, msoTrue, _
msoTrue, 50, 50)
MediaObject.Name = "MediaOBject1"
Set FirstBookMark = AddBookMark(MediaObject, 5000, "bm1")
Set AnimatedShape = Slide.shapes.AddShape(msoShapeRectangle, _
0, 0, 100, 50)
Dim Sequence As Sequence: Set Sequence = Slide.TimeLine.InteractiveSequences.Add(1)
Set FirstEffect = Sequence.AddTriggerEffect(pShape:=AnimatedShape, effectId:=msoAnimEffectAppear, _
trigger:=msoAnimTriggerOnMediaBookmark, pTriggerShape:=MediaObject, BookMark:="bm1")
End Sub
我要添加音频书签和 将它们关联到 VBA.
中 Timing 对象的 TriggerBookmark 属性要添加书签,此功能可以完成工作:
Function AddBookMark(ByRef MediaObject As Shape, ByVal PositionInMs As Long, ByVal BookMarkName As String) As MediaBookmark
Dim Result As MediaBookmark
With MediaObject
Set Result = .MediaFormat.MediaBookmarks.Add(Position:=PositionInMs, name:=BookMarkName)
End With
Set AddBookMark = Result
End Function
下面这段代码
- 添加媒体对象
- 向该媒体对象添加 2 个书签
- 添加一个矩形形状
- 创建并影响 AnimationBehaviour
动画有效,但我想根据创建的书签启动动画效果。 2 条注释行不起作用。 有人明白为什么吗?
Sub SetBookMarkAsTriggerTest()
FileName = "C:\path\to\your.mp3"
Dim Slide As Slide
Dim MediaObject As Shape
Dim AnimatedShape As Shape
Dim FirstBookMark As MediaBookmark
Dim SecondBookMark As MediaBookmark
Dim FirstEffect As Effect
Dim SecondEffect As Effect
Dim Behaviour As AnimationBehavior
Set Slide = ActivePresentation.Slides(1)
Set MediaObject = Slide.shapes.AddMediaObject2(FileName, msoTrue,_
msoTrue, 50, 50)
MediaObject.name = "MediaOBject1"
Set FirstBookMark = AddBookMark(MediaObject, 5000, "bm1")
Set SecondBookMark = AddBookMark(MediaObject, 7000, "bm2")
Set AnimatedShape = Slide.shapes.addShape(msoShapeRectangle, _
0, 0, 100, 50)
Set FirstEffect = Slide.TimeLine.MainSequence.AddEffect(Shape:=AnimatedShape, _
EffectId:=msoAnimEffectFade, Trigger:=msoAnimTriggerAfterPrevious)
FirstEffect.Timing.Duration = 10
Set Behaviour = FirstEffect.Behaviors.Add(msoAnimTypeMotion)
With Behaviour
With .motionEffect
.FromX = 0
.FromX = 0
.ToX = 50
.ToY = 50
End With
With .Timing
.Duration = 2
'this line does not work...why ?
'.TriggerType = msoAnimTriggerOnMediaBookmark
'this line does not work neither...why ?
'.TriggerBookmark = "bm1"
End With
End With
End Sub
非常感谢!
我设法通过使用 InteractiveSequences 完成了我想做的事情。 然后我们可以根据书签使用 AddTriggerEffect 方法添加触发效果如下:
Function AddBookMark(ByRef MediaObject As Shape, ByVal PositionInMs As Long, ByVal BookMarkName As String) As MediaBookmark
Dim result As MediaBookmark
With MediaObject
Set result = .MediaFormat.MediaBookmarks.Add(Position:=PositionInMs, Name:=BookMarkName)
End With
Set AddBookMark = result
End Function
Sub SetBookMarkAsTriggerTest()
fileName = "C:\path\to\your.mp3"
Dim Slide As Slide
Dim MediaObject As Shape
Dim AnimatedShape As Shape
Dim FirstBookMark As MediaBookmark
Dim FirstEffect As effect
Dim Behaviour As AnimationBehavior
Set Slide = ActivePresentation.Slides(1)
Set MediaObject = Slide.shapes.AddMediaObject2(fileName, msoTrue, _
msoTrue, 50, 50)
MediaObject.Name = "MediaOBject1"
Set FirstBookMark = AddBookMark(MediaObject, 5000, "bm1")
Set AnimatedShape = Slide.shapes.AddShape(msoShapeRectangle, _
0, 0, 100, 50)
Dim Sequence As Sequence: Set Sequence = Slide.TimeLine.InteractiveSequences.Add(1)
Set FirstEffect = Sequence.AddTriggerEffect(pShape:=AnimatedShape, effectId:=msoAnimEffectAppear, _
trigger:=msoAnimTriggerOnMediaBookmark, pTriggerShape:=MediaObject, BookMark:="bm1")
End Sub