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的功能与Format Painter相同。复制完所需的动画后，您可以使用动画窗格重新排序各个动画。

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

3 个答案: