Excel VBA将形状移动到列

Question

我的 Excel VBA 课程的程序有问题。我编写了一个程序，将线条、矩形、椭圆形和三角形各 5 个添加到工作表中，这就是 btnAddShapes 点击事件。在 cmdAlignRectangles 单击事件中，我试图仅采用添加的矩形并将它们全部对齐在 C 列中。我使用了 For Each 循环来选择工作表上的所有形状，分配需要 For Each 循环结构。然后我使用 If/Then 语句来选择形状类型 msoShapeRectangle。我使用了在创建矩形时分配的名称，例如“Box1”，使用计数器遍历每个矩形，正是这个语句给了我一个错误，指出找不到具有该名称的项目。我必须使用 Range 和 Shape 对象的 Left 属性来移动矩形。？任何帮助或指导将不胜感激。

Private Sub btnAddShapes_Click()

Randomize
For I = 1 To 5    
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 50, 100, 100, 65).Select
    With Selection
        .Name = "Box" & I
        .Left = Int(422 * Rnd)
        .Top = Int(422 * Rnd)
    End With

    ActiveSheet.Shapes.AddLine(10 + I * (Rnd * 133), 50 + I * (Rnd * 133), 125 + I * (Rnd * 133), 250 + I * (Rnd * 133)).Select
    With Selection
        .Name = "Line" & I
    End With

    ActiveSheet.Shapes.AddShape(msoShapeOval, 275, 240, 108, 44).Select
    With Selection
        .Name = "Oval" & I
        .Left = Int(444 * Rnd)
        .Top = Int(444 * Rnd)
    End With

    ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, 514, 220, 93, 71).Select
    With Selection
        .Name = "Triangle" & I
        .Left = Int(377 * Rnd)
        .Top = Int(377 * Rnd)
    End With

Next I
End Sub

Private Sub btnRemoveShapes_Click()
Dim sh As Shape

For Each sh In ActiveSheet.Shapes
    If Not (sh.Type = msoOLEControlObject Or sh.Type = msoFormControl Or sh.Type = msoTextBox) Then sh.Delete
Next sh

End Sub

Private Sub cmdAlignRectangles_Click()

Dim allRectangles As Shapes
Dim sh As Shape
Dim I As Integer

Set allRectangles = ActiveSheet.Shapes

I = 1

For Each sh In allRectangles
    If sh.Type = msoShapeRectangle Then
        ActiveSheet.Shapes("Box" & I).Left = Cells(I, 3).Left
    End If
    I = I + 1
Next
End Sub

Answer 1

错误在于，在创建循环中，您为每个 1 创建 4 个形状，I 从 1 变为 5。另一方面，在对齐循环中，您为每个形状迭代一个 I。因此，当我达到 6（第 6 个形状）时，名为“Box6”的对象不存在。

实现这一点的更简单方法是通过检查形状的名称来修改我们的测试，例如：

If sh.Type = msoShapeRectangle And InStr(sh.Name, "Box") = 1 Then
    sh.Left = Cells(I, 3).Left
End If

附言你也可以放弃测试的第一部分