如何使用 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

下面这段代码

  1. 添加媒体对象
  2. 向该媒体对象添加 2 个书签
  3. 添加一个矩形形状
  4. 创建并影响 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