使用 VBA 在 Excel 中重塑自由形状

Question

我正在尝试使用 VBA 在 Excel 中制作“涂鸦”形状（自由形式）的动画，但我无法让它移动。我能够使用以下代码对连接器形状进行动画处理，该代码将连接器的曲线调整为“S”形状：

Sub Macro3()

   ActiveSheet.Shapes.Range(Array("Curved Connector 2")).Select
   Selection.ShapeRange.Adjustments.Item(1) = 0.71994
   tiempo (0.25)
   ActiveSheet.Shapes.Range(Array("Curved Connector 2")).Select
   Selection.ShapeRange.Adjustments.Item(1) = 0.59967
   tiempo (0.25)
   ActiveSheet.Shapes.Range(Array("Curved Connector 2")).Select
   Selection.ShapeRange.Adjustments.Item(1) = 0.48627
   tiempo (0.25)
   ActiveSheet.Shapes.Range(Array("Curved Connector 2")).Select
   Selection.ShapeRange.Adjustments.Item(1) = 0.35912
   tiempo (0.25)
End Sub

哪里

Sub tiempo(duration_ms As Double)
Start_time = Timer
Do
DoEvents
Loop Until (Timer - Start_time) >= duration_ms

End Sub

但是，当我尝试对“涂鸦”（或自由形式）形状应用类似的方法时，它不会移动。我尝试在手动调整形状的同时录制宏，但是当我重播宏时，没有任何反应。

以前有人在 Excel 中对自由形状进行过动画处理吗？如何使用 VBA 以编程方式移动涂鸦形状的顶点？任何提示或代码示例将不胜感激！

提前致谢！

Answer 1

阅读：ShapeNodes.SetPosition 方法 (Excel)

ShapeNodes.SetPosition 设置 Index 指定的节点的位置。请注意，根据节点的编辑类型，此方法可能会影响相邻节点的位置。

姓名	必填/可选	数据类型	描述
索引	必填	长	要设置位置的节点。
X1	必填	单人	新节点相对于文档左上角的位置（以磅为单位）。
Y1	必填	单人	新节点相对于文档左上角的位置（以磅为单位）。

这是我的测试设置。 我创建了几个可以使用的形状。 在每次测试期间，我都会复制一个形状并将其命名为 Snake。 接下来我记录形状顶点。 顶点的值与节点值相同。

正确输入变量将使编写代码变得更容易。 如果您不确定对象的类型是什么，请运行您的代码并在立即窗口中使用 ?TypeName() 来获取其类型。

？类型名称（Sheet4.Shapes（“蛇”））

形状

Sub Test()
    Dim Snake As Shape
    Set Snake = Sheet4.Shapes("Snake")
    
    Dim Nodes As ShapeNodes
    Set Nodes = Snake.Nodes

    Dim FirstNode As ShapeNode
    Set FirstNode = Nodes(1)
    
    Nodes.SetPosition 1, FirstNode.Points(1, 2) + 10, FirstNode.Points(1, 2) + 10
    Stop
End Sub


Sub RecordVerticies()
    Dim Snake As Shape
    Set Snake = Sheet4.Shapes("Snake")
  
    Range("A1:B1").Value = Array("X", "Y")
    Range("A2").Resize(Nodes.Count, 2).Value = Snake.Vertices
End Sub

如何预测节点位置的变化对我来说并不直观，因为它们是相对于文档（工作表）的左上角的。