我的vba“对象”根据我的代码不会移动

时间:2018-06-16 03:35:11

标签: excel vba excel-vba

Sub macro1()

    rep_count = 0

    Do
    DoEvents

    rep_count = rep_count + 1

    Sheet1.Shapes("rectangle").Left = rep_count

    Sheet1.Shapes("rectangle").Top = rep_count

    Sheet1.Shapes("rectangle").Height = rep_count

    Sheet1.Shapes("rectangle").Width = rep_count

    timeout (0.01)

    Loop Until rep_count = 300
End Sub


Sub timeout()

    start_time = Timer

    Do

    DoEvents

    Loop Until (Timer - start_time) >= duration_ms

End Sub

错误一直说“the error

enter image description here

1 个答案:

答案 0 :(得分:1)

您正在将参数传递给不在声明中的超时子过程。

Sub timeout(duration_ms as double)  '<~~ pass parameter in here

    dim start_time as double

    start_time = Timer

    Do
        DoEvents
    Loop Until (Timer - start_time) >= duration_ms

End Sub

小心你不要在时间跨越午夜时使用它。计时器是午夜过后的秒数(和毫秒数),并在午夜重置为零。

您可以通过选择并将此请求传递到VBE的立即窗口来检索形状的名称。 ?Selection.ShapeRange.name

enter image description here

使用ActiveSheet或工作表(“sheet1”)按名称引用形状,而不是工作表的代号。

Sub macro1()

    Dim rep_Count As Long
    rep_Count = 0

    Do
        DoEvents

        rep_Count = rep_Count + 1

        'With ActiveSheet.Shapes("Rectangle 1")
        With Worksheets("sheet1").Shapes("Rectangle 1")
            .Left = rep_Count
            .Top = rep_Count
            .Height = rep_Count
            .Width = rep_Count
        End With

        timeout (0.01)

    Loop Until rep_Count = 300
End Sub