CODEWITHSUNDEEP
vbaanimationpowerpoint
Math Helper
Math Helper

Reputation: 21

How to remove animation on PowerPoint after it has played in slideshow without using .AddShape with VBA

Here is my code: (Using PowerPoint 2016)

Sub MacroTest()
Dim Shp As Shape
Dim effNew As Effect
Dim sldOne As Slide

Set sldOne= ActivePresentation.Slides(1)
Set Shp = ActivePresentation.Slides(1).Shapes(2)
Set effNew = sldOne.Timeline.MainSequence _ 
.AddEffect(Shape:=Shp, _ 
effectid:=msoAnimEffectSpin, _ 
Trigger:=msoAnimTriggerWithPrevious)

End Sub

My goal with this code is to see if I can apply it to a PowerPoint game. I want to be able to have the user click a button to make a box spin, and then have the animation deleted immediately after so that if they click it again, it won't play two or more spin animations. Also, I want the animation deleted so the animation pane won't have hundreds of spin animations in it.

Most the examples I have seen use .AddShape, because the animation disappears with the shape - however, it would be easier to apply an animation to an existing shape that I can see and interact with when designing a game.

I am aware that this is achievable without VBA, using triggers, but I eventually want to incorporate if then statements and more code to this once I get the hang of it.

I appreciate any help, I am very new to VBA so it means a lot.

Upvotes: 1

Views: 614

Answers (1)

Math Helper
Math Helper

Reputation: 21

Okay so I figured it out. This is for anyone who is having a similar problem.

Code:

Sub MacroTest

Dim Shp As Shape
Dim effNew As Effect
Dim sldOne As Slide

Dim time As Date
Dim count As Integer

Set sldOne = ActivePresentation.Slides(1)
Set Shp = ActivePresentation.Slides(1).Shapes(2)
Set effNew = sldOne.TimeLine.MainSequence _
.AddEffect(Shape:=Shp, _
effectid:=msoAnimEffectSpin, _
Trigger:=msoAnimTriggerWithPrevious)

time = Now()
count = 2

time = DateAdd("s", count, time)

Do Until time < Now()
DoEvents

With effNew
    With ActivePresentation.Slides(1).Shapes(4). _
    TextFrame.TextRange
        .Text = Format((time - Now()), "hh:mm:ss")
        If .Text = ("00:00:00") Then
            effNew.Delete
        Else
        End If
    End With
End With

Loop

End Sub

So, What I had to do was create a timer, which lasts as long as the spin animation I am using. Then I used an if statement for when that timer reaches 00:00:00 to delete the effect. Hope this helps.

Upvotes: 1

Related Questions