如何在 excel 2007 vba 中以编程方式对一组形状进行分组？

Question

I am iterating over data on the Electrical Tables sheet and creating shapes on a Shape sheet. Once the shapes are created I would like to programmatically group them. However I can't figure out the right syntax. The shapes are there, selected, and if I click the group button, they group perfectly. However with the following code I get

Runtime Error 438 Object does not support this method or property.

I am basing this code on VBA examples off the web - I am not a strong VBA programmer. What is the right way to do this? I am working with excel 2007 and switching excel versions isn't an option.

Problematic snippet:

Set shapeSheet = Worksheets("Shapes")

With shapeSheet
    Selection.ShapeRange.Group.Select
End With

Context:

Dim shapeSheet As Worksheet
Dim tableSheet As Worksheet
Dim shpGroup As Shape

Set shapeSheet = Worksheets("Shapes")
Set tableSheet = Worksheets("Electrical Tables")


With tableSheet
    For Each oRow In Selection.Rows
            rowCount = rowCount + 1
            Set box1 = shapeSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 50, 50 + ((rowCount - 1) * 14), 115, 14)
            box1.Select (False)
            Set box1Frame = box1.TextFrame
            Set box2 = shapeSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 165, 50 + ((rowCount - 1) * 14), 40, 14)
            box2.Select (False)
            Set box2Frame = box2.TextFrame
     Next
End With

Set shapeSheet = Worksheets("Shapes")

With shapeSheet
    Selection.ShapeRange.Group.Select
End With

Answer 1

No need to select first, just use

Set shpGroup = shapeSheet.Shapes.Range(Array(Box1.Name, Box2.Name)).Group

PS. the reason you get the error is that the selection object points to whatever is selected on the sheet (which will not be the shapes just created) most likely a Range and Range does not have a Shapes property. If you happened to have other shapes on the sheet and they were selected then they would be grouped.

Answer 2

This worked for me in Excel 2010:

Sub GroupShapes()

    Sheet1.Shapes.SelectAll
    Selection.Group

End Sub

I had two shapes on sheet 1 which were ungrouped before calling the method above, and grouped after.

Edit

To select specific shapes using indexes:

Sheet1.Shapes.Range(Array(1, 2, 3)).Select

Using names:

Sheet1.Shapes.Range(Array("Oval 1", "Oval 2", "Oval 3")).Select

Answer 3

Here's how you can easily group ALL shapes on a worksheet that doesn't require you to Select anything:

ActiveSheet.DrawingObjects.Group

If you think/know that there are already groupings for any shapes on your current worksheet, then you'll need to first Ungroup those shapes:

ActiveSheet.DrawingObjects.Ungroup  'include if groups already exist on the sheet
ActiveSheet.DrawingObjects.Group

---

I'm aware this answer is slightly off-topic but have added it as all searches for Excel shape grouping tend to point to this question

Answer 4

I had the same problem, but needed to select a couple of shapes (previously created by the macro and listed in an array of shapes), but not "select.all" because there might be other shapes on the slide.

The creation of a shaperange was not really easy. The easiest way is just to cycle through the shape objects (if you already know them) and select them simulating the "hold ctrl key down" with the option "Replace:=False".

So here's my code:

For ix = 1 To x
    bShp(ix).Select Replace:=False
Next
ActiveWindow.Selection.ShapeRange.Group

Hope that helps, Kerry.

Answer 5

I can see many solutions here, but I would like to share with You my way to deal with this topic without knowing shapes name or number and without using ActiveSheet or Select .

The code below will group every shape on set worksheet.

Dim arr_txt() As Variant
Dim ws As Worksheet
Dim i as Long

set ws = ThisWorkbook.Sheets(1)

With ws
    ReDim arr_txt(1 To .Shapes.Count)
    For i = 1 To .Shapes.Count
        arr_txt(i) = i 'or .Shapes(i).Name
    Next
    .Shapes.Range(arr_txt).Group
End With