CODEWITHSUNDEEP
vbapowerpoint
commodore73
commodore73

Reputation: 61

PowerPoint VBA: How to set Animation Start event to "With Previous"

In a PowerPoint macro, I want to set "Start" in the "Timing" group on the Animation tab to "With Previous". Today is my first with VBA, so please don't laugh at my code:

Sub adjustAll() Dim osld As Slide Dim oshp As Shape

For Each osld In ActivePresentation.Slides
    For Each oshp In osld.Shapes
        If oshp.Type = msoMedia Then
            If oshp.MediaType = ppMediaTypeSound Then
                oshp.Left = 460.7499
                oshp.Top = 250.7499
                oshp.AnimationSettings.PlaySettings.LoopUntilStopped = True
            End If
        End If
    Next oshp
Next osld
End Sub

Maybe I need to use AddEffect(), but that seems a bit overcomplicated? I have seen some docs and posts but haven't found the property to set or the value to apply.

I don't mean to ask multiple questions, but if anyone can assist further or tell me where to RTFM, for another object, I would like to set the same thing to "On Click", and also set "Appear" in the "Animation" group and "As One Object" for "Effect Options".

Update: This is very close to working:

Sub adjustAll() Dim osld As Slide Dim oshp As Shape

For Each osld In ActivePresentation.Slides
    For i = osld.TimeLine.MainSequence.Count To 1 Step -1
        osld.TimeLine.MainSequence(i).Delete
    Next i
    For Each oshp In osld.Shapes
         If oshp.Type = msoPlaceholder Then
            If oshp.Name <> "Content Placeholder 2" Then
                oshp.AnimationSettings.Animate = False
            End If
            If oshp.Name = "Content Placeholder 2" Then
                Set oeff = osld.TimeLine.MainSequence.AddEffect(Shape:=oshp, effectid:=msoAnimEffectAppear, trigger:=msoAnimTriggerOnPageClick)
                oshp.AnimationSettings.AnimationOrder = 1
            End If
        End If
        If oshp.Type = msoMedia Then
            If oshp.MediaType = ppMediaTypeSound Then
                Set oeff = osld.TimeLine.MainSequence.AddEffect(Shape:=oshp, effectid:=msoAnimEffectMediaPlay, trigger:=msoAnimTriggerWithPrevious)
                oshp.Left = 460.7499
                oshp.Top = 250.7499
                oshp.ScaleHeight 0.2, msoTrue
                oshp.ScaleWidth 0.2, msoTrue
                oshp.AnimationSettings.PlaySettings.LoopUntilStopped = True
            End If
        End If
    Next oshp
Next osld
End Sub

Except I end up with two triggers, which doesn't look right, but doesn't seem to cause problems.

enter image description here

Update: Hopefully final update. I think I just needed to clear the default animation for the audio. I added this towards the top of the condition:

            If oshp.MediaType = ppMediaTypeSound Then
                oshp.AnimationSettings.Animate = False

Upvotes: 2

Views: 3571

Answers (1)

John Korchok
John Korchok

Reputation: 4923

PowerPoint programming is a bit overcomplicated. AddEffect is exactly what you need to use:

Sub AdjustTable()
  Dim oSlide As Slide
  Dim oShape As Shape
  Dim oEffect As Effect
  For Each oSlide In ActivePresentation.Slides
    For Each oShape In oSld.Shapes
      If oShape.Type = msoMedia Then
        If oShape.MediaType = ppMediaTypeSound Then
          oShape.Left = 460.7499
          oShape.Top = 250.7499
          Set oEffect = oSlide.TimeLine.MainSequence.AddEffect(Shape:=oShape, _
          effectid:=msoAnimEffectMediaPlay, MsoAnimateByLevel:=msoAnimateLevelNone, _
          MsoAnimTriggerType:=msoAnimTriggerWithPrevious)
        End If
      End If
    Next oShape
  Next oSlide
End Sub

BTW, if you only check the placeholder for the Media type, you'll miss any video inserted in a Content placeholder.

Upvotes: 3

Related Questions