vba code for motion paths

  • Thread starter Thread starter Ted
  • Start date Start date
T

Ted

I can use fromx tox etc or path= approachs to mk an obkct move along a
path.

But i cannot get this activity to repeat until mouse click (.

Alos would lik to add a pause in th motion path.

Any ideas?

Here is my code for motion:


Sub Moveshape()
'
'
Dim shp1, shp2 As Shape
Dim eff1, eff2, eff3, eff4 As Effect
Dim ani1, ani2, ani3, ani4 As AnimationBehavior
Dim intShape As Integer

Set shp1 = ActivePresentation.Slides(1).Shapes.AddShape _
(msoShapeSmileyFace, 0, 0, 100, 100#)

Set eff1 = ActivePresentation.Slides(1).TimeLine.MainSequence _
.AddEffect(Shape:=shp1, effectid:=msoAnimEffectCustom)


Set eff2 = ActivePresentation.Slides(1).TimeLine.MainSequence _
.AddEffect(Shape:=shp1, effectid:=msoAnimEffectCustom)

Set eff3 = ActivePresentation.Slides(1).TimeLine.MainSequence _
.AddEffect(Shape:=shp1, effectid:=msoAnimEffectCustom)

Set eff4 = ActivePresentation.Slides(1).TimeLine.MainSequence _
.AddEffect(Shape:=shp1, effectid:=msoAnimEffectCustom)

Set ani1 = eff1.Behaviors.Add(msoAnimTypeMotion)

Set ani2 = eff2.Behaviors.Add(msoAnimTypeMotion)

Set ani3 = eff3.Behaviors.Add(msoAnimTypeMotion)

Set ani4 = eff4.Behaviors.Add(msoAnimTypeMotion)


With eff1.Timing
.Duration = 1
.TriggerType = msoAnimTriggerAfterPrevious
End With

With eff2.Timing
.Duration = 1
.TriggerType = msoAnimTriggerAfterPrevious
End With

With eff3.Timing
.Duration = 1
.TriggerType = msoAnimTriggerAfterPrevious
End With

With eff4.Timing
.Duration = 1
.TriggerType = msoAnimTriggerAfterPrevious
End With

With ani1.MotionEffect
.FromX = 0
.FromY = 0
.ToX = 0.5
.ToY = 0
End With

With ani2.MotionEffect
.FromX = 0.5
.FromY = 0
.ToX = 0.5
.ToY = 0.5
End With

With ani3.MotionEffect
.FromX = 0.5
.FromY = 0.5
.ToX = 0
.ToY = 0.5
End With

With ani4.MotionEffect
.FromX = 0
.FromY = 0.5
.ToX = 0
.ToY = 0
End With


End Sub
 
Back
Top