VBA - is it possible to have a series of trigger events that start after previous

[ajarmstron]

Hi - I have a slide that consists of groups of two rectangles connected by a line. What I want to do is click on the left hand side rectangle and animate both the two rectangles and line by using an animation timeline with a trigger event attached to the left hand side rectangle.

At the moment I can do this, but only if I use the setting "trigger on click". This means there has to be three clicks on the same shape for all 3 shapes to do my desired animation!

Is it possible to code the timeline so that my second and third shapes will automatically start animating after the first event? PowerPoint does have msoAnimTriggerAfterPrevious - however, it is not letting me use this!

I attach code that will automatically generate the affect described above.

Thank you!

Sub test()


Dim MyDocument As Slide
Dim MyShape As Shape
Dim MyShape2 As Shape
Dim oLine As Shape
Dim stringName As String
Dim lineName As String
Dim intTableRows As Integer
Dim i As Integer
Dim oeff As Effect
Dim beff As AnimationBehavior
Set MyDocument = ActivePresentation.Slides(1)

'I note there are 3 connected shapes (1) a rectangle named "Keyword1"  (2) a connecting line named "Line1" and (3) a second rectangle "Definition1"

Set MyShape = MyDocument.Shapes.AddShape(msoShapeRectangle, 100, 200, 300, 200)
MyShape.Fill.ForeColor.RGB = RGB(255, 255, 255)
MyShape.Name = "Keyword1"


Set MyShape = MyDocument.Shapes.AddShape(msoShapeRectangle, 500, 200, 300, 200)
MyShape.Fill.ForeColor.RGB = RGB(255, 255, 255)
MyShape.Name = "Definition1"


                    
Set oLine = MyDocument.Shapes.AddLine(400, 300, 500, 300)
                
With oLine
    .Line.Weight = 1
    .Line.ForeColor.RGB = RGB(0, 0, 0)
    .Name = "Line1"
End With


'This adds the first shape to the timeline. The animation changes the fill colour of the rectangle Keyword1
    stringName = "Keyword1"

    Set MyShape = MyDocument.Shapes(stringName)

    Set oeff = ActivePresentation.Slides(1).TimeLine. _
      InteractiveSequences.Add().AddEffect(Shape:=MyShape, _
      effectId:=msoAnimEffectChangeFillColor, trigger:=msoAnimTriggerOnShapeClick)
      
    Set beff = oeff.Behaviors.Add(msoAnimTypeSet)


    With beff.SetEffect
        .Property = msoAnimShapeFillColor
        .To = RGB(Red:=0, Green:=255, Blue:=0)
    End With
    
    With oeff.Timing
        .Duration = 1
        .TriggerShape = MyShape
    End With


    'This is the code for the second animation which is for a line to do a wipe entrance from the left.
    stringName = "Line1"


    Set MyShape2 = MyDocument.Shapes(stringName)


    Set oeff = ActivePresentation.Slides(1).TimeLine. _
      InteractiveSequences.Add().AddEffect(Shape:=MyShape2, _
      effectId:=msoAnimEffectWipe, trigger:=msoAnimTriggerOnShapeClick)
    'I note I have not been able to change the msoAnimTriggerOnShapeClick setting


    With oeff
        .EffectParameters.Direction = msoAnimDirectionLeft
    End With


    With oeff.Timing
        .Duration = 0.5
        .TriggerShape = MyShape 'Note MyShape is different to MyShape2
    End With


    'This is the code for the third animation which is for the rectangle Definition1 to change colour
    stringName = "Definition1"
    Set MyShape2 = MyDocument.Shapes(stringName)
    
    Set oeff = ActivePresentation.Slides(1).TimeLine. _
      InteractiveSequences.Add().AddEffect(Shape:=MyShape2, _
      effectId:=msoAnimEffectChangeFillColor, trigger:=msoAnimTriggerOnShapeClick)
    'I note I have not been able to change the msoAnimTriggerOnShapeClick setting


    Set beff = oeff.Behaviors.Add(msoAnimTypeSet)


    With beff.SetEffect
        .Property = msoAnimShapeFillColor
        .To = RGB(Red:=0, Green:=255, Blue:=0)
    End With
    
    With oeff.Timing
        .Duration = 1
        .TriggerShape = MyShape
    End With

'End With

End Sub