如何使用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？

回答

相關問題