vba - my vba "object" wont move according to my code

Question

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 keep saying "the error

标签： vbaexcel

Answer 1

You are passing an argument into the timeout sub procedue that is not in the declaration.

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

Be careful that you do not use this as time crosses midnight. Timer is the number of seconds (and milliseconds) past midnight and resets to zero at midnight.

You can retrieve the shape's name by selecting it and passing this request to the VBE's Immediate window. ?Selection.ShapeRange.name

Use ActiveSheet or Worksheets("sheet1") to reference the shape by name, not the worksheet's codename.

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