在迭代选择一组形状时，如何将当前选择和新创建的形状进行分组？

Question

我是一个完全的VBA新手，下面是我的情况。

Sub Align_Capability_Level()

Set myDocument = ActiveWindow.View.Slide

For Each sh In ActiveWindow.Selection.ShapeRange

    sh.Name = "bigBox"

    Set lilSquare = myDocument.Shapes.AddShape(msoShapeRectangle, _
        Left:=sh.Left + (sh.Width - Size), Top:=sh.Top + (sh.Height - Size), Width:=Size, Height:=Size)

    lilSquare.Name = "smallBox"

    myDocument.Shapes.Range(Array("smallBox", "bigBox")).Group

Next

End Sub

当我选择三个盒子时，它会将选择中的第一个项目和新创建的盒子分组，但它会停止并显示这个错误。

ShapeRange对象必须包含至少两个项目。

Answer 1

我猜你的问题来自于命名。该代码在第一次迭代中工作，将第一个形状和第一个创建的盒子分组。在这次迭代中，您将形状命名为 Bigbox 和 Smallbox. 代码会把这两个形状快乐地组合在一起。

如果现在你选择了另一个形状，或者再执行一次代码，你会给下一个形状也取名为 BigBox 和新创建的盒子 Smallbox. 不幸的是，这是有可能的--然而，这将会使我们的工作变得混乱。Group-命令，这将尝试将第一个 Bigbox 和第一个 Smallbox-形状 - 由于这些已经是一个组的一部分，你会得到错误信息。

试试下面的代码。

For Each sh In ActiveWindow.Selection.ShapeRange
    Dim lilSquare As Shape
    Set lilSquare = myDocument.Shapes.AddShape(msoShapeRectangle, _
        Left:=sh.Left + (sh.Width - size), Top:=sh.Top + (sh.Height - size), Width:=size, Height:=size)
    lilSquare.Name = sh.Name & "_smallBox"
    myDocument.Shapes.Range(Array(sh.Name, lilSquare.Name)).Group
Next