VBA and Custom Motion Paths

  • Thread starter Thread starter ristmi
  • Start date Start date
R

ristmi

I'm trying to create a custom motion path for a shape in Powerpoint
(Office Powerpoint 2003 - 11.8110.8107 SP2) using VBA code. However, if
I copy sample code from MSDN, such as...

Sub AddMotionPath()
Dim shpNew As Shape
Dim effNew As Effect
Dim aniMotion As AnimationBehavior
Set shpNew = ActivePresentation.Slides(1).Shapes _
.AddShape(Type:=msoShape5pointStar, Left:=0, _
Top:=0, Width:=100, Height:=100)
Set effNew = ActivePresentation.Slides(1).TimeLine.MainSequence _
.AddEffect(Shape:=shpNew, effectId:=msoAnimEffectCustom, _
Trigger:=msoAnimTriggerWithPrevious)
Set aniMotion = effNew.Behaviors.Add(msoAnimTypeMotion)
With aniMotion.MotionEffect
.FromX = 0
.FromY = 0
.ToX = 500
.ToY = 500
End With
End Sub

.... I just end up with a shape (5 point start obviously) on my slide
that has a custom animation property (i.e. Modify: Custom) but no
motion path (i.e. the shape has no motion/animation effects).

Any ideas why the MSDN codes does not work for me? Thanks in advance.
 
Apparently, the MSDN example is a little unclear. ToX and FromX are
measured in percentage (1 = 100%) of slide width/height (not absolute
numbers) - therefore, when the MSDN example gives a value of 50, this
means that the shape's final coordinates will be 50 times the
width/height of the slide size! (correspondingly, 0.1 = 10% of the
slide width/height, a far more appropriate value)

Further, 'duration' is measured in seconds, which sets how long the
animation effect is presumed to last. The 'speed' (default = 1) sets
how fast the animation appears to take - for example, setting 'speed =
2' completes the animation effect in half the duration time... HOWEVER,
subsequent animation effects that are set to AFTER PREVIOUS will only
fire after the duration time.

CODE: (assumes Slide1 exists)

Dim shpNew As Shape
Dim effNew As Effect
Dim aniMotion As AnimationBehavior
Set shpNew = Slide1.Shapes.AddShape(msoShape5pointStar, Left:=0,
Top:=0, Width:=100, Height:=100)
Set effNew = Slide1.TimeLine.MainSequence.AddEffect(Shape:=shpNew,
effectId:=PowerPoint.MsoAnimEffect.msoAnimEffectCustom,
Trigger:=PowerPoint.MsoAnimTriggerType.msoAnimTriggerWithPrevious)
Set aniMotion = effNew.Behaviors.Add(MsoAnimType.msoAnimTypeMotion)

effNew.Timing.Speed= 1
effNew.Timing.Duration = 2

With aniMotion.MotionEffect
.FromX = 0
.FromY = 0
.ToX = 0.1
.ToY = 0.1
End With
 
Back
Top