VBA command to animate disappear via "collapse"

[bennyjohn5]

I previously animated two shapes using a PowerPoint trigger to make one disappear with the "collapse" animation followed by the next appearing with the "stretch" animation.

Modifying the presentation, I need the same click to move a third shape to the back - hence I am trying to carry out these animations using VBA commands.

Please can you help?

Sub click1()

ActivePresentation.SlideShowWindow.View.Slide.Shapes("Rounded Rectangle 73").ZOrder msoBringToFront

'a command to animate disappear via "collapse" on "Rounded Rectangle 72"
'a command to animate appearance via "stretch" on "Rounded Rectangle 74"

End Sub

[John Wilson]

Do you need this to work in Show Mode. Note i have changed the names of the shapes to make it easier to understand

This may work


Sub Animate_em()
Dim osld As Slide
Set osld = SlideShowWindows(1).View.Slide
With osld.TimeLine.MainSequence.AddEffect(osld.Shapes("front"), msoAnimEffectStretch, , msoAnimTriggerWithPrevious)
.Exit = True
End With
Call osld.TimeLine.MainSequence.AddEffect(osld.Shapes("back"), msoAnimEffectStretch, , msoAnimTriggerAfterPrevious)
End Sub

[bennyjohn5]

Thanks for your help John. Not quite sorted, I'm afraid.

The user needs to repeatedly click on the shapes, your code keeps adding more to the animation pane - not what I want.

I attach a very simplified version of my project game. I essentially want a bit of VBA to do what the animation already does plus move the visible shape to the front so that when "esc" is pressed and the ppt is saved the board layout is retained.

[bennyjohn5]

Why doesn't the second command work? I don't want to add effects to the timeline - I simply want to use the "stretch" and "collapse" effect.

ActivePresentation.SlideShowWindow.View.Slide.Shapes("Rounded Rectangle 73").ZOrder msoBringToFront
ActivePresentation.SlideShowWindow.View.Slide.Shapes("Rounded Rectangle 73").msoAnimEffectStretch

[John Wilson]

There's no way to "just use" the effect they have to be added to the timeline.

You might be able to delete any existing entries and just have one. You will need to work on this example


Option Explicit
Dim oeff As Effect
Dim oeff2 As Effect
Sub Animate_em()
Dim osld As Slide
On Error Resume Next
oeff.Delete
oeff2.Delete
Set osld = SlideShowWindows(1).View.Slide
Set oeff = osld.TimeLine.MainSequence.AddEffect(osld.Shapes("front"), msoAnimEffectStretch, , msoAnimTriggerWithPrevious)
oeff.Exit = True
Set oeff2 = osld.TimeLine.MainSequence.AddEffect(osld.Shapes("back"), msoAnimEffectStretch, , msoAnimTriggerAfterPrevious)
DoEvents
End Sub