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

我已将几个形状分组为一组。我们称之为Group1。我想要在Group1中获取Shape1的BottomRightCell/TopLeftCell。但每当我运行此代码：如何使用VBA在Excel中获取组内形状的BottomRightCell/TopLeftCell？

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

我拿到小组第一，而不是特定的shape1的右下角单元格的右下角单元格的行。我也试过这个：

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

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

来源

2017-04-04 pomeloyou

不知道，但我认为这是可能你可能需要取消组合形状，得到你想要的，然后重新组合形状。 –

从逻辑上讲，你所要求的不应该是可能的。 Excel的手册说，分组使得形状“被视为一个单一的对象”。因此，分组形状应该已经失去与工作表的个人关系。为什么你要在确保他们像一个团体一样行动后个别地移动他们？ – Variatus

@Variatus恕我直言，OP要求什么_应该是可能的。 Excel提供了“GroupItems”集合来访问组中的各个形状。对于“GroupItems”属性中的每个项目“Top”和“Left”报告都是正确的，并且可以修改以移动各个组项目。似乎对于GroupItems中的项目，“TopLeftCell”和“BottomRightCell”都是错误的，并且对整个组进行报告。 –

似乎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集合重复组外，并报告其单元位置。然后删除重复。

我用矩形来证明，但其他形状类型应该是相似的

来源

2017-04-04 03:34:50

它的工作原理！虽然这很麻烦，但我想它比将它们重新组合并再次分组要好得多。感谢解决这个问题的创造性方式。你摇滚！ – pomeloyou

谢谢@pomeloyou。这是一个PITA，可以解决越野车属性问题，我认为最好不要混淆原始组本身。 –

您可以实现@ 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

来源

2017-04-04 03:51:20

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

回答

相关问题