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

How do I group a set of shapes programmatically in excel 2007 vba?

提问by Andrew Bucknell

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.

运行时错误 438 对象不支持此方法或属性。

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.

我将此代码基于网络上的 VBA 示例 - 我不是一个强大的 VBA 程序员。这样做的正确方法是什么？我正在使用 excel 2007，不能选择切换 excel 版本。

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

采纳答案by Nick Spreitzer

This worked for me in Excel 2010:

这在 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.

我在工作表 1 上有两个形状，它们在调用上述方法之前未分组，然后分组。

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

回答by chris neilsen

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 notbe the shapes just created) most likely a Rangeand Rangedoes not have a Shapesproperty. If you happened to have other shapes on the sheet and they were selected then they would be grouped.

附注。您收到错误的原因是选择对象指向工作表上选择的任何内容（不会是刚刚创建的形状），很可能是 aRange并且Range没有Shapes属性。如果您碰巧在工作表上有其他形状并且它们被选中，那么它们将被分组。

回答by Marcucciboy2

Here's how you can easily group ALLshapes on a worksheet that doesn't require you to Selectanything:

以下是您可以轻松将工作表上的所有形状分组的方法，不需要您进行Select任何操作：

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 Ungroupthose shapes:

如果您认为/知道当前工作表上已经有任何形状的分组，那么您需要首先Ungroup对这些形状进行分组：

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

我知道这个答案有点偏离主题，但已添加它，因为所有对 Excel 形状分组的搜索都倾向于指向这个问题

回答by Kerry

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.

我遇到了同样的问题，但需要选择几个形状（以前由宏创建并列在形状数组中），但不是“select.all”，因为幻灯片上可能还有其他形状。

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".

创建 shaperange 并不容易。最简单的方法是循环遍历形状对象（如果您已经知道它们）并选择它们，模拟“按住 ctrl 键”和选项“替换：=假”。

So here's my code:

所以这是我的代码：

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

Hope that helps, Kerry.

希望有帮助，凯瑞。

回答by Teamothy

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 ActiveSheetor Select.

我可以在这里看到许多解决方案，但我想与您分享我在不知道形状名称或数字且不使用ActiveSheet或 的情况下处理此主题的方法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