vba - パワーポイントの図形間でアニメーションとシーケンス情報をコピーする

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