Question

我的Excel VBA课程有问题。我编写了一个程序，将5行，矩形，椭圆和三角形添加到工作表中，这是btnAddShapes单击事件。在cmdAlignRectangles单击事件中，我试图仅采用已添加的矩形并将它们全部对齐在C列中。我使用For Each循环选择工作表上的所有形状，分配需要For Each循环结构。然后我使用If / Then语句选择形状类型msoShapeRectangle。我在创建矩形时使用了我指定的名称，例如“Box1”，使用计数器I迭代每个矩形，这个语句给我一个错误，说明找不到具有该名称的项目。我必须使用 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个形状，我从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

P.S。你也可以放弃测试的第一部分

Excel VBA将形状移动到列

1 个答案: