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

Matt Wilson
Matt Wilson used Ask the Experts™
on
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
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Senior Technical Consultant at BrightCarbon
Commented:
You can pickup the animation from one shape to another as follows:

With ActiveWindow.Selection
  .ShapeRange(1).PickupAnimation
  .ShapeRange(2).ApplyAnimation
End With

Open in new window


The Apply method you're using is for the Format painter tool.

Author

Commented:
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
Jamie GarrochSenior Technical Consultant at BrightCarbon

Commented:
You're welcome Matt! Glad it worked for you.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial