Canpoint VBA Timeline.Mainsequence动画和Timeline.InteractiveSequences动画可以从一种形状转移到另一种形状吗?

时间:2018-06-04 04:21:09

标签: vba animation triggers powerpoint transfer

我正在尝试将一些已存在的动画(包括触发动画)从一个形状移动到另一个形状。我主要使用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相关的动画似乎也无法正常工作。

所以问题是,任何人都可以帮助我移动现有的动画并将动画从一种形状触发到另一种形状吗?

0 个答案:

没有答案