Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to manage PowerPoint Bookmarks and trigger effects based on them using VBA?

Tags:

powerpoint

vba

I would like to add bookmarks of audio and associate them to the TriggerBookmark property of the Timing Object in VBA.

To Add Bookmarks this Function does the job :

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

This code below

  1. Adds the media object
  2. Adds 2 bookMarks to that media object
  3. Adds A rectangle Shape
  4. Create and effect and an AnimationBehaviour

The animation works but I would like to launch the motion effect based on the created bookmarks. The 2 Commented lines does not work. Does SomeOne understand why?

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

Thanks a lot!

like image 548
kas Avatar asked Feb 01 '26 02:02

kas


1 Answers

I managed to do what I wanted by using the InteractiveSequences. We Can then add a trigger effect with the AddTriggerEffect method based on a bookmark As Follow :

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
like image 168
kas Avatar answered Feb 03 '26 20:02

kas



Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!