如何在Excel中使用VBA获取组内形状的BottomRightCell / TopLeftCell？

我已经把几个形状组合成一个组。 我们称之为Group1。 我想要在Group1中获取Shape1的BottomRightCell / TopLeftCell。 但是每当我运行这个代码：

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

我得到该组的右下单元格的行，而不是特定的shape1的右下单元格。 我也试过这个：

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

同样的事情发生。 即使它被分组了，我如何获得Shape1的bottomrightcell？

Answer 1

看来， GroupItems中的项目TopLeftCell和BottomRightCell是越野车，并作为一个整体的报告。

在对比属性Top和Left中为GroupItems集合中的项目正确报告。

作为一个解决scheme考虑这一点：

 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集合中创build每个形状的GroupItems并报告其单元格位置。 然后删除重复。

我用矩形来演示，但其他的形状types应该是相似的

Answer 2

您可以使用以下代码示例实现@ MatsMug的解决scheme。

在Ungroup之后使用Regroup方法创build一个比第一个名称更新的分组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