首页 文章

Excel VBA将形状移动到列

提问于
浏览
0

我的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

1 回答

  • 0

    错误是在创建循环中为每个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
    

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

相关问题