我正在尝试将一些已存在的动画(包括触发动画)从一个形状移动到另一个形状。我主要使用Powerpoint 2010,所以我希望得到适用于此版本程序的答案。首先,我尝试了Shape.PickupAnimation和Shape.ApplyAnimation方法,但它们不能用于交互式序列,实际上似乎将一些交互式序列动画转储到MainSequence时间轴上,这使得尝试清理这些方法的混乱程度更加糟糕比我希望的解决方案。
以下是我编写的一些代码,用于说明我遇到的问题。
Sub TransferAnimations()
Dim i As Integer
Dim j As Integer
Dim firstShp As Shape
Dim secondShp As Shape
Dim copyShp As Shape
Dim firstEffect As Effect
Dim secondEffect As Effect
Dim thirdEffect As Effect
Dim fourthEffect As Effect
Dim oSld As Slide
Set oSld = ActivePresentation.Slides.AddSlide(ActivePresentation.Slides.Count + 1, _
ActivePresentation.Slides(1).CustomLayout)
Set firstShp = oSld.Shapes.AddShape(msoShape5pointStar, 100, 100, 50, 50)
Set secondShp = oSld.Shapes.AddShape(msoShape16pointStar, 200, 100, 50, 50)
firstShp.Name = "FirstShape"
secondShp.Name = "SecondShape"
'Make some mainsequence animations
Set firstEffect = oSld.TimeLine.MainSequence.AddEffect(firstShp, _
msoAnimEffectTeeter, msoAnimateLevelNone, msoAnimTriggerOnPageClick)
Set secondEffect = oSld.TimeLine.MainSequence.AddEffect(secondShp, _
msoAnimEffectTeeter, msoAnimateLevelNone, msoAnimTriggerOnPageClick)
'Make two interactive sequence animations One where the first shape is the
'trigger shape, the other where the firstShp is the shape animated.
Set thirdEffect = oSld.TimeLine.InteractiveSequences.Add _
.AddTriggerEffect(firstShp, msoAnimEffectSpin, msoAnimTriggerOnShapeClick, secondShp)
Set fourthEffect = oSld.TimeLine.InteractiveSequences.Add _
.AddTriggerEffect(secondShp, msoAnimEffectSpin, msoAnimTriggerOnShapeClick, firstShp)
'Make the shape we will try to move the animations to
Set copyShp = oSld.Shapes.AddShape(msoShapeCross, 300, 100, 50, 50)
copyShp.Name = "CopyShape"
'Move the mainsequence animation to the copyShp. We will find the
'effect we want to transfer to the copyShp indirectly by searching
'with a for loop instead of using our variable 'firstEffect'
'because that is what I do in my real code.
For i = oSld.TimeLine.MainSequence.Count To 1 Step -1
If oSld.TimeLine.MainSequence.Item(i).Shape Is firstShp Then
oSld.TimeLine.MainSequence(i).Shape = copyShp
End If
Next i
'Move the interactiveSequence animations
With oSld.TimeLine.InteractiveSequences
For i = .Count To 1 Step -1
For j = .Item(i).Count To 1 Step -1
If .Item(i).Item(j).Shape Is firstShp Then
.Item(i).Item(j).Shape = copyShp
End If
If .Item(i).Item(j).Timing.TriggerShape Is firstShp Then
.Item(i).Item(j).Timing.TriggerShape = copyShp
End If
Next j
Next i
End With
'Ideally at this point I would like to delete the shape that I copied
'the animations from but if I do that then all the entries in the
'timeline that now appropriately refer to the copyShp are deleted with
'the firstShp
Dim Answer As String
Answer = MsgBox("Should I delete the first Shape?", vbQuestion + vbYesNo, "Delete?")
If Answer = vbYes Then
firstShp.Delete
End If
End Sub
如果我在调试模式下逐行进入此代码,所有动画似乎都正确设置并且看起来完美地分配给动画窗格中的新形状....直到我尝试删除firstShp 。然后,从动画窗格中删除最初与firstShp关联但现在分配给copyShp的所有动画。
当然,即使我没有删除firstShp,幻灯片上与firstShp相关的动画似乎也无法正常工作。
所以问题是,任何人都可以帮助我移动现有的动画并将动画从一种形状触发到另一种形状吗?