Automate Animation Settings

[Rudi]

Hi,

I have a PPT presentation template that I use on a weekly basis. The first slide has a "table of contents" simply providing a hyperlinked list of topics found in the presentation. Clicking the TOC entry takes one directly to the slide for that topic.

The TOC has a small animation connected to it as illustrated in the attached. I find that when I update or create a new PPT from the template I need to rebuild this animation (or ensure that each point has the appropriate delay on it to produce the effect). I was hoping to have a small macro that I can run on the active placeholder that would do the following:

1. Remove (clear) the animation to start with
2. Re-animate each point in the active placeholder with Fly In from left
3. Add the delay timing by adding the * + 0.25 second increment for each point

If I can run a macro that does this it will prevent me from having to recreate or check each new point I add to the TOC. The macro will simply clear and add the animation correctly no matter how many points I add to the TOC.

Any assistance/advice to create this macro would be greatly appreciated.
TX

Auto Animate.pptx

[HansV]

I don't understand PowerPoint VBA, so I can't really help you, but perhaps the following will get you on your way:
Create Custom Animations
Otherwise, you may have better luck asking your question in the Microsoft Community forums, specifying Office as Category and PowerPoint as Office Topic; lots of PowerPoint MVPs hang out there.

[Rudi]

TX. I'll dabble a bit, and then post there if I need more help.
If I get a working solution I'll upload the code for reference for others.

[Rudi]

My dabbling did not work
I have asked the same question on the Microsoft Community Board here.

[HansV]

You'll probably get a helpful reply there.

[HansV]

I see that you already got a reply from John Wilson.

[Rudi]

Yes TX. I wasn't expecting a reply so quickly.
The macro is working beautifully, barring 2 minor changes.
99% there.....

[Rudi]

Thanks to John's patience and expertise, I now have the macro working perfectly.
Much appreciated John, and TX Hans for pointing me in that direction.
Source thread

The macro (for reference)
Note: You must select the placeholder BEFORE you run the macro!

Code: Select all

Sub AnimateAuto()
Dim osld As Slide
Dim oshp As Shape
Dim oeff As Effect
Dim L As Long
Dim currCount As Long
    On Error GoTo Err
    Set oshp = ActiveWindow.Selection.ShapeRange(1)
    Set osld = oshp.Parent
    For L = osld.TimeLine.MainSequence.Count To 1 Step -1
        If osld.TimeLine.MainSequence(L).Shape.Id = oshp.Id Then _
           osld.TimeLine.MainSequence(L).Delete
    Next L
    currCount = osld.TimeLine.MainSequence.Count
    Set oeff = osld.TimeLine.MainSequence.AddEffect _
               (oshp, msoAnimEffectFly, msoAnimateTextByAllLevels, msoAnimTriggerWithPrevious)
    For L = currCount To 1 Step -1
        osld.TimeLine.MainSequence(1).MoveTo osld.TimeLine.MainSequence.Count
    Next L
    For L = 1 To oshp.TextFrame.TextRange.Paragraphs.Count
        With osld.TimeLine.MainSequence(L)
            .EffectParameters.Direction = msoAnimDirectionLeft
            .Timing.TriggerDelayTime = (L - 1) * 0.1
            .Timing.Duration = 0.5
        End With
    Next L
    Exit Sub
Err:
    MsgBox Err.Description
End Sub

Attached is a sample file with the working code...

Auto Animate.pptm

[HansV]

Great!

Don't forget to mark John's reply / replies as the Answer to your question (you can mark more than one reply as the Answer if you wish, up to three, I think).

[Rudi]

I did do, though I will mark as answer one more as there are a few great replies.
I also marked a few as helpful.

Cheers! :)

[HansV]

Thanks!