G
Geoff Cox
Hello,
Code works but not sure why!
The aim is to click on shpAnswer to move the shpRectangle in the way
defined by the FromX etc.
This works and uses the FromX etc co-ordinates and ignores the
effectId:=msoAnimEffectPathCurvyStar, _
which is fine! But what should replace this parameter? A gap is not
allowed and adding msoAnimEffectCustom is wrong.
Cheers
Geoff
Sub AddShapeSetTiming()
Sub AddShapeSetTiming()
Dim effDiamond As Effect
Dim shpRectangle As Shape
Dim aniMotion As AnimationBehavior
Dim shpAnswer As Shape
'create shape to be clicked
Set shpAnswer = ActivePresentation.Slides(1).Shapes _
..AddShape(Type:=msoShapeRectangle, Left:=100, _
Top:=400, Width:=75, Height:=50)
shpAnswer.TextFrame.TextRange.Text = "answer"
'create shape to be moved
Set shpRectangle = ActivePresentation.Slides(1).Shapes _
..AddShape(Type:=msoShapeRectangle, Left:=100, _
Top:=200, Width:=75, Height:=50)
shpRectangle.TextFrame.TextRange.Text = "word"
'effect applies to the shape to be moved when other shape is clicked
Set effDiamond = _
ActivePresentation.Slides(1).TimeLine.InteractiveSequences.Add _
..AddEffect(Shape:=shpRectangle, _
effectId:=msoAnimEffectPathCurvyStar, _
Trigger:=msoAnimTriggerOnShapeClick)
With effDiamond.Timing
..Duration = 2
..TriggerDelayTime = 0
End With
Set aniMotion = effDiamond.Behaviors.Add(msoAnimTypeMotion)
With aniMotion.MotionEffect
.FromX = 0.00000638889
.FromY = -0.0000037037
.ToX = 0.48039
.ToY = -0.32569
End With
effDiamond.Timing.TriggerShape = shpAnswer
End Sub
Code works but not sure why!
The aim is to click on shpAnswer to move the shpRectangle in the way
defined by the FromX etc.
This works and uses the FromX etc co-ordinates and ignores the
effectId:=msoAnimEffectPathCurvyStar, _
which is fine! But what should replace this parameter? A gap is not
allowed and adding msoAnimEffectCustom is wrong.
Cheers
Geoff
Sub AddShapeSetTiming()
Sub AddShapeSetTiming()
Dim effDiamond As Effect
Dim shpRectangle As Shape
Dim aniMotion As AnimationBehavior
Dim shpAnswer As Shape
'create shape to be clicked
Set shpAnswer = ActivePresentation.Slides(1).Shapes _
..AddShape(Type:=msoShapeRectangle, Left:=100, _
Top:=400, Width:=75, Height:=50)
shpAnswer.TextFrame.TextRange.Text = "answer"
'create shape to be moved
Set shpRectangle = ActivePresentation.Slides(1).Shapes _
..AddShape(Type:=msoShapeRectangle, Left:=100, _
Top:=200, Width:=75, Height:=50)
shpRectangle.TextFrame.TextRange.Text = "word"
'effect applies to the shape to be moved when other shape is clicked
Set effDiamond = _
ActivePresentation.Slides(1).TimeLine.InteractiveSequences.Add _
..AddEffect(Shape:=shpRectangle, _
effectId:=msoAnimEffectPathCurvyStar, _
Trigger:=msoAnimTriggerOnShapeClick)
With effDiamond.Timing
..Duration = 2
..TriggerDelayTime = 0
End With
Set aniMotion = effDiamond.Behaviors.Add(msoAnimTypeMotion)
With aniMotion.MotionEffect
.FromX = 0.00000638889
.FromY = -0.0000037037
.ToX = 0.48039
.ToY = -0.32569
End With
effDiamond.Timing.TriggerShape = shpAnswer
End Sub