CODEWITHSUNDEEP
vbaexcel
pomeloyou
pomeloyou

Reputation: 157

How to Get the BottomRightCell/TopLeftCell of a shape inside a group in Excel using VBA?

I have grouped a few shapes into a group. Let's call it Group1. I want to get the BottomRightCell/TopLeftCell of a particular 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 instead of the particular shape1's bottom right cell. I also tried this:

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

Same thing happened. How do I get the Shape1's bottomrightcell even though it is grouped?

Upvotes: 4

Views: 3212

Answers (2)

Robin Mackenzie
Robin Mackenzie

Reputation: 19289

You can implement @MatsMug's solution with the following code sample.

Using the Regroup method after Ungroup creates a grouped Shape with a new name than the first one, so the code resets the new grouped Shape to have the original name:

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

Upvotes: 0

chris neilsen
chris neilsen

Reputation: 53136

It seems that for items in GroupItems TopLeftCell and BottomRightCell are buggy and report on the group as a whole.

In contrast properties Top and Left report correctly for items in the GroupItems collection.

As a work-around consider this:

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

Here I create a duplicate of each shape in the GroupItems Collection outside the group and report its cell position. Then delete the duplicate.

I've used Rectangles to demonstrate, but other shape type should be similar

Upvotes: 4

Related Questions