How to get BottomRightCell / TopLeftCell forms inside a group in Excel using VBA?

I grouped several shapes into a group. Let me call him Group1. I want to get a BottomRightCell / TopLeftCell of a specific shape Shape1 in Group1. But whenever I run this code:

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

I get the row of the bottom right cell of the group, not the specific bottom right cell of form1. I also tried this:

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

The same thing happened. How to get the formula Shape1, even if it is grouped?

+4
source share
2 answers

It seems that for elements in GroupItems TopLeftCelland BottomRightCellare errors and the group as a whole is reported.

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 . .

Rectangles ,

+3

@MatsMug .

Regroup Ungroup Shape , , Shape, :

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
0

Source: https://habr.com/ru/post/1673941/


All Articles