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
VBAMicrosoft PowerPoint

Avatar of undefined
Last Comment
Jamie Garroch (MVP)

8/22/2022 - Mon
ASKER CERTIFIED SOLUTION
Jamie Garroch (MVP)

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
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
Jamie Garroch (MVP)

You're welcome Matt! Glad it worked for you.
This is the best money I have ever spent. I cannot not tell you how many times these folks have saved my bacon. I learn so much from the contributors.
rwheeler23