在 VBA Excel 中按形状对象对形状进行分组

Question

我在 Excel 中使用 VBA 按名称对形状进行分组时遇到问题。
发生这种情况是因为我有多个可以具有相同名称的形状。

以下代码可以重现我的问题。
您可以取消注释行 OriginalShape.Name = "MyShape" 以查看错误。

Sub test()
    
    ' Create Original Shape
    Dim OriginalShape As Shape
    Set OriginalShape = Sheet1.Shapes.AddShape(msoShapeRectangle, 5, 20, 50, 50)
    
    ' Rename Shape to simulate my project
'    OriginalShape.Name = "MyShape" ' Uncomment line to recreate problem
    
    ' Copy and Paste Shape (I believe there is no other way to do this)
    OriginalShape.Copy
    Sheet1.Paste Sheet1.Range("C2")
    
    ' Get Object of Last Pasted Shape
    Dim CloneShape As Shape
    Set CloneShape = Sheet1.Shapes(Sheet1.Shapes.Count)
    
    ' Group Shapes
    Dim ShapeGroup As Shape
    Set ShapeGroup = Sheet1.Shapes.Range(Array(OriginalShape.Name, CloneShape.Name)).Group

End Sub

我知道我也有可能使用形状索引，例如Sheet1.Shapes.Range(Array(1, 2)).Group，但这似乎也不是一个好方法，因为我需要为每个形状（形状索引）存储一个另外的变量从形状对象。

有没有办法以其他方式对形状进行分组，例如通过对象或 ID。 我相信最好的应该是这样的。

Set ShapeGroup = Sheet1.Shapes.Range(Array(OriginalShape, CloneShape)).Group
'OR
Set ShapeGroup = Sheet1.Shapes.Range(Array(OriginalShape.ID, CloneShape.ID)).Group

Answer 1

就像 Tim Williams 所说：代码失败，因为 group-array 由相同的名称组成。您需要做的是在创建形状时将索引添加到名称中

这将起作用：

Sub test()
    
   
    Const cntShapes As Long = 2
    
    
    Dim i As Long, shp As Shape, cTarget As Range
    Dim arrShapeNames(1 To cntShapes) As Variant
    
    With Sheet1
        For i = 1 To cntShapes
            Set cTarget = .Cells(1, i)   'adjust this to your needs
            Set shp = .Shapes.AddShape(msoShapeRectangle, cTarget.Left, cTarget.Top, 50, 50)
            shp.Name = "MyShape." & i   'adding the index to the name makes it unique
            arrShapeNames(i) = shp.Name
        Next
    End With
    
    
    ' Group Shapes
    Dim ShapeGroup As Shape
    Set ShapeGroup = Sheet1.Shapes.Range(arrShapeNames).Group

End Sub