PPT2007. VBA. Add Motion Path Effect to a Shape

[KL]

Hi there,

Can anyone share a VBA code snippet for adding Motion Path to a shape in PPT2007 please? This one (slightly adjusted) works in
PPT2003, but not in PPT2007:
http://msdn2.microsoft.com/en-us/library/aa201181(office.10).aspx

Thanks and regards,
--
KL
[MVP - Microsoft Excel]
RU: http://www.mvps.ru/Program/Default.aspx
ES: http://mvp.support.microsoft.com/?LN=es-es
EN: http://mvp.support.microsoft.com/?LN=en-us
Profile: http://mvp.support.microsoft.com/profile/Kirill

 

[Shyam Pillai]

That's broken in PPT 2007. Instead use the more reliable way of setting the
motion path by specifying a VML string containing the co-ordinates.

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
.Path = "M 0 0 L -0.25 0 E"
End With

End Sub

Regards,
Shyam Pillai


Image Importer Wizard
http://skp.mvps.org/iiw.htm

 

[KL]

Hi Shyam,

That's broken in PPT 2007. Instead use the more reliable way of setting the motion path by specifying a VML string containing the
co-ordinates.

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
.Path = "M 0 0 L -0.25 0 E"
End With

End Sub

Thank you very much, I have already found a thread in another forum where you gave this advice to someone else and it worked nicely
for me.

Reagrds,

--
KL
[MVP - Microsoft Excel]
RU: http://www.mvps.ru/Program/Default.aspx
ES: http://mvp.support.microsoft.com/?LN=es-es
EN: http://mvp.support.microsoft.com/?LN=en-us
Profile: http://mvp.support.microsoft.com/profile/Kirill