vba - 在 powerpoint 形状之间复制动画和序列信息

Question

我正在尝试用另一种类型的形状对象（矩形）替换幻灯片上的所有形状对象（图片）。我可以删除旧对象并创建新对象，但我会丢失所有动画信息和序列顺序。是否可以将动画信息和顺序存储在时间轴中，并将其复制到新的形状对象中？

Answer 1

好吧，我自己找到了一个解决方案，希望有人能发现它有用。因此，无需将动画信息从旧形状复制到新形状，只需循环遍历序列的项目并将形状对象引用替换为新形状即可。像这样：

On Error Resume Next
Dim shp1 As Shape 'old shape
Set shp1 = ActivePresentation.Slides(1).Shapes(3)

Dim shp2 As Shape 'new shape
Set shp2 = ActivePresentation.Slides(1).Shapes.AddPicture("c:\imgres2.jpg", msoFalse, msoTrue, 0, 0) 'it is important to create new shape before cycling through existing ones.
For i = ActivePresentation.Slides(1).TimeLine.MainSequence.count To 1 Step -1
    'using "is" opeartor to compare refrences
    If shp1 Is ActivePresentation.Slides(1).TimeLine.MainSequence.Item(i).Shape Then
        ActivePresentation.Slides(1).TimeLine.MainSequence.Item(i).Shape = shp2
    End If
Next i
shp1.Delete 'delete the old shape

Answer 2

尝试类似这样的代码将动画复制到新添加的形状中：

Sub PasteAnimationBehaviours()

Dim SHP As Shape 'for existing shape
Set SHP = ActivePresentation.Slides(1).Shapes(1)
    SHP.PickupAnimation


Dim newSHP As Shape 'pasting to new shape
Set newSHP = ActivePresentation.Slides(1).Shapes.AddShape(msoShapeRectangle, 100, 100, 100, 100)
    newSHP.ApplyAnimation

End Sub

在评论后添加：如果您只需要替换形状类型，请尝试使用以下内容：

Sub ShapeSubstition()

Dim SHP As Shape 'for existing shape
'test for 1st shape in 1st slide
Set SHP = ActivePresentation.Slides(1).Shapes(1) 

SHP.AutoShapeType = msoShapeRectangle 'to rectangle
SHP.AutoShapeType = msoShapeOval   'to oval
End Sub

Answer 3

我认为使用“Animation Painter”命令按钮复制动画并将它们应用到另一个对象可能更容易。Animation Painter 的功能与 Format Painter 相同。复制所需的动画后，您可以使用动画窗格重新排序各个动画。