Link to home
Start Free TrialLog in
Avatar of Matt Wilson
Matt Wilson

asked on

How can I force the Animation Painter to paste in VBA?

In PowerPoint VBA, I'm trying to use the Animation Painter to copy the animation from one picture to the other pictures on a slide. My code successfully turns on the Animation Painter and it successfully selects the next picture, but I can't actually get the paste to work. If I pause execution right after the Animation painter is turned on then I can manually select the next the picture and the animation is successfully copied. So how do I force the paste? Here is the code:

Sub animaPainter()

Dim osh As Shape
Dim nameSelect As String

nameSelect = ActiveWindow.Selection.ShapeRange.Name

For Each osh In ActiveWindow.Selection.SlideRange.Shapes

            With osh
            If osh.Name = nameSelect Then GoTo LoopEnd
                If .Type = msoLinkedPicture _
                  Or .Type = msoPicture _
                Then
                  togglePainter
                  osh.Select msoTrue
                  osh.Apply
                 
                End If
            End With
LoopEnd:
 
Next

End Sub

Private Sub togglePainter()

Dim localApp As PowerPoint.Application
Set localApp = GetObject(Class:="PowerPoint.Application")
localApp.CommandBars.ExecuteMso ("AnimationPainter")

End Sub
ASKER CERTIFIED SOLUTION
Avatar of Jamie Garroch (MVP)
Jamie Garroch (MVP)
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Matt Wilson
Matt Wilson

ASKER

Thanks a lot. That worked like a charm. And much easier than my method. Below is the final code to make this thing work.

Sub animaPainter()

Dim osh As Shape
Dim nameSelect As String

nameSelect = ActiveWindow.Selection.ShapeRange.Name
ActiveWindow.Selection.ShapeRange(nameSelect).PickupAnimation

For Each osh In ActiveWindow.Selection.SlideRange.Shapes

            With osh
            If osh.Name = nameSelect Then GoTo LoopEnd
                If .Type = msoLinkedPicture _
                  Or .Type = msoPicture _
                Then
                  osh.ApplyAnimation
                End If
            End With
LoopEnd:
 
Next

End Sub
You're welcome Matt! Glad it worked for you.