VBAを使用してExcelでグループ内の図形のBottomRightCell/TopLeftCellを取得する方法は？

Question

私はグループにいくつかの図形をグループ化しました。それをGroup1と呼ぶことにしよう。 Group1の特定の図形Shape1のBottomRightCell/TopLeftCellを取得したいと思います。しかし、このコードを実行するたびに：

ActiveSheet.Shapes("Group1").GroupItems("Shape1").BottomRightCell.Row 

特定のshape1の右下のセルではなく、グループの右下のセルの行が表示されます。 私もこれを試しました：

ActiveSheet.Shapes("Shape1").BottomRightCell.Row 

同じことが起こりました。 Shape1の最下部のセルをグループ化してもどうやって取得できますか？

Answer 1

GroupItemsTopLeftCellとBottomRightCellの項目はバグでグループ全体として報告されているようです。

コントラストプロパティTopおよびLeftは、GroupItemsコレクションの項目について正しくレポートします。

回避策は、この検討したよう：ここ

Sub Demo() 
    Dim ws As Worksheet 
    Dim grp As Shape 
    Dim shp As Shape, s As Shape 
    Set ws = ActiveSheet 
    Set grp = ws.Shapes("Group 1") '<~~ update to suit 
    With grp 
     For Each shp In .GroupItems 
      ' Create a temporary duplicate shape 
      Set s = ws.Shapes.AddShape(msoShapeRectangle, shp.Left, shp.Top, shp.Width, shp.Height) 

      ' Report the grouped shape to contrast the temporary shape result below 
      Debug.Print shp.TopLeftCell.Row, shp.BottomRightCell.Row 
      ' Report the duplicate shape to see correct location 
      Debug.Print s.TopLeftCell.Row, s.BottomRightCell.Row 

      ' Delete temporary shape 
      s.Delete 
     Next 
    End With 
End Sub 

私はグループ外のGroupItemsコレクション内の各形状の複製を作成し、そのセルの位置を報告します。その後、複製を削除します。

は私が実証する四角形を使用しましたが、他の形状のタイプが似ている必要があり

Answer 2

あなたは次のコードサンプルでMatsMugのソリューション@実装することができます。

Ungroupが最初のものよりも新しい名前でグループ化されたShapeを作成し、そのコードは新しいが、元の名前を持つようにShapeをグループ化しリセットした後Regroupメソッドを使用：

Option Explicit 

Sub Test() 

    Dim ws As Worksheet 
    Dim shpGrouped As Shape 
    Dim strGroupShameName As String 
    Dim lngGroupedShapeCount As Long 
    Dim lngCounter As Long 
    Dim strShapeArray() As String 

    Set ws = ThisWorkbook.Worksheets("Sheet1") '<~~ your sheet 

    ' group 
    Set shpGrouped = ws.Shapes("Group 7") '<~~ your grouped shape 
    lngGroupedShapeCount = shpGrouped.GroupItems.Count 
    strGroupShameName = shpGrouped.Name 

    ' store child shapes in array 
    ReDim strShapeArray(1 To lngGroupedShapeCount) 
    For lngCounter = 1 To lngGroupedShapeCount 
     strShapeArray(lngCounter) = shpGrouped.GroupItems(lngCounter).Name 
    Next lngCounter 

    ' ungroup 
    shpGrouped.Ungroup 

    ' report on shape locations 
    For lngCounter = 1 To lngGroupedShapeCount 
     Debug.Print ws.Shapes(strShapeArray(lngCounter)).TopLeftCell.Address 
     Debug.Print ws.Shapes(strShapeArray(lngCounter)).BottomRightCell.Address 
    Next lngCounter 

    ' regroup and rename 
    With ws.Shapes.Range(strShapeArray).Regroup 
     .Name = strGroupShameName 
    End With 

End Sub