Question

我有多个图表和一些箭头形状（链接到Sheet2上的某些单元格以显示单元格的值），所有这些都放在一个合并单元格E5的边界内。

当我向单元格添加不同的形状甚至图表然后尝试运行代码将它们组合在一起时，此代码有效。但是，我认为它似乎不适用于从枢轴引用范围的图表......我可能在这里错了，它可能完全是某种东西。

Option Explicit

Sub doit()
    Call GroupShapes(Sheet2.Cells(5, "E"))
End Sub

Sub GroupShapes(rngChart As Range)
    Dim Shp As Shape
    Dim ShpRng As ShapeRange
    Dim ShpGrp As Variant
    Dim Arr() As Variant
    Dim i As Long

    i = 1
    With rngChart.Parent
        For Each Shp In .Shapes
            If Shp.TopLeftCell.MergeArea.Row = rngChart.MergeArea.Row Then
                ReDim Preserve Arr(1 To i)
                Arr(i) = Shp.Name
                i = i + 1
            End If
        Next Shp

        Set ShpRng = .Shapes.Range(Arr)

       ' Here i get "Application defined or Object defined error"
       Set ShpGrp = ShpRng.Group

       With ShpGrp
          .Name = "shp" & VBA.Replace(rngChart.Parent.Name, " ", "")
       End With
   End With
End Sub

如果我选择所有形状，然后尝试手动或通过代码对它们进行分组（如下所示），它会进行分组。我做错了什么？

Sub doit1()
Dim rngChart As Range

Sheet2.Activate
With Sheet2
    Set rngChart = .Cells(5, "E")
End With
Call GroupShapes1(rngChart)

End Sub

Sub GroupShapes1(rngChart As Range)
Dim Shp As Variant
Dim Arr() As Variant

With rngChart.Parent
    For Each Shp In .Shapes
        If Not Intersect(.Range(Shp.TopLeftCell.MergeArea.Cells, Shp.BottomRightCell.MergeArea.Cells), rngChart) Is Nothing Then
            Shp.Select Replace:=False
        End If
    Next Shp
    Set Shp = Selection.Group
End With
End Sub

我想对形状进行分组，而不选择它们。如果有人知道为什么会这样，请帮助。

Answer 1

我发现图表没有被选中的原因是因为每个图表都被命名为相同的I.e. Object13，虽然他们的ID不同。因此，一旦我使用唯一名称重命名每个形状和图表（此处ID就足够了），就可以进行分组。

Option Explicit 

Sub doit() 
    Call GroupShapes(Sheet2.Cells(5, "E")) 
End Sub 

Sub GroupShapes(rngChart As Range) 
Dim Shp As Shape 
Dim ShpRng As ShapeRange 
Dim ShpGrp As Variant 
Dim Arr() As Variant 
Dim i As Long i = 1 

With rngChart.Parent 
    For Each Shp In .Shapes 
        If Shp.TopLeftCell.MergeArea.Row = rngChart.MergeArea.Row Then 
            With Shp
                .Name = .Type & .ID
            End With

            ReDim Preserve Arr(1 To i) 
            Arr(i) = Shp.Name 
            i = i + 1 
        End If 
    Next Shp 

    Set ShpRng = .Shapes.Range(Arr) 
    Set ShpGrp = ShpRng.Group 

    With ShpGrp 
        .Name = "shp" & VBA.Replace(rngChart.Parent.Name, " ", "") 
    End With 
End With 
End Sub

将链接的单元格引用分组

1 个答案: