如何通过PowerPoint VBA使用动画时间线可靠地更改矩形的填充颜色

Question

我正在使用PowerPoint VBA进行编码，但在尝试使用动画时间线和msoAnimEffectChangeFillColor可靠地更改形状(矩形(的填充颜色时遇到了困难。发生的情况是，在第一种情况下，效果如预期一样，但重复相同的形状(通常是第二次或第三次(会导致替换颜色变为另一种不希望的颜色(通常是橙色(。我相信这很容易复制。

如果您创建一个PowerPoint并插入一个填充的矩形并运行以下宏(例如单击矩形时(，则第一次单击会更改为预期颜色(此处为红色(。然而，如果你继续运行宏，颜色(最终(会变为橙色！如果有人能解释为什么会发生这种情况，我将不胜感激，如果有解决方案，请告诉我！我所做的另一个观察是，我经常必须在Visual Basic编辑器中重置项目，以便动画重新开始工作。

Dim oshp As Shape
Dim oeff As Effect
Dim MyDocument As Slide
Sub rectangle()
'I don't know if we need this first bit of code but it removes any existing animations on the current timeline'
Dim i As Integer
For i = ActivePresentation.Slides(1).TimeLine.MainSequence.Count To 1 Step -1
ActivePresentation.Slides(1).TimeLine.MainSequence(1).Delete
Next i
'This is the code to create the animation.
Set MyDocument = ActivePresentation.Slides(1)
Set oshp = MyDocument.Shapes("Rectangle 3")
Set oeff = MyDocument.TimeLine.MainSequence.AddEffect _
(Shape:=oshp, effectid:=msoAnimEffectChangeFillColor, trigger:=msoAnimTriggerWithPrevious)
oeff.EffectParameters.Color2.RGB = RGB(255, 0, 0)
oeff.Timing.Duration = 0.25
oeff.Timing.TriggerDelayTime = 0.5
End Sub

Answer 1

我很高兴写下我已经找到了问题的答案，这可能对其他人有用。解决方案是在Sub中声明变量。我不确定是否有规则规定必须始终如此。所以代码看起来是这样的：

Sub rectangle()
Dim oshp As Shape
Dim oeff As Effect
Dim MyDocument As Slide
'This first bit of code removes any existing animations on the current
'timeline and is not part of the animation.
Dim i As Integer
For i = ActivePresentation.Slides(1).TimeLine.MainSequence.Count To 1 Step -1
ActivePresentation.Slides(1).TimeLine.MainSequence(1).Delete
Next i
'This is the code to create the animation.
Set MyDocument = ActivePresentation.Slides(1)
Set oshp = MyDocument.Shapes("Rectangle 3")
Set oeff = MyDocument.TimeLine.MainSequence.AddEffect _
(Shape:=oshp, effectid:=msoAnimEffectChangeFillColor, trigger:=msoAnimTriggerWithPrevious)
oeff.EffectParameters.Color2.RGB = RGB(255, 0, 0)
oeff.Timing.Duration = 0.25
oeff.Timing.TriggerDelayTime = 0.5
End Sub