0

I am trying to move a picture and then make the code sleep for a while. The problem is, the position of the picture does not update before "sleeping". Here is the code:

Worksheets("Sheet1").Shapes("Picture1").IncrementLeft 100
Sleep 500

When I execute this code(the sub is called by a button), the position of the picture does not change until the end of "sleep 500".

How can I update the picture before sleep? I will be much appreciated if you can also explain this to me.


Update using DoEvents: I created a new excel file, with only the picture and button in the sheet, and the following code(full code):

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
Sub Button1_Click()
Worksheets("Sheet1").Shapes("Picture 2").IncrementLeft 100
DoEvents
Sleep 2000
End Sub

and it still doesn't work. Or did I misunderstood the usage of "DoEvents"? I apologize if I am being stupid.


Update using GetTickCount and suggestion from braX: I am using another WinAPI GetTickCount to serve as timer for DoEvent loop. Now it seems to work with smaller time interval?

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
Private Declare Function GetTickCount Lib "kernel32" () As Long

Sub Button1_Click()
Move_Right_With_Time "Sheet1", "Picture1", 50, 100
Move_Right_With_Time "Sheet1", "Picture1", 80, 200
Move_Right_With_Time "Sheet1", "Picture1", 300, 300
Move_Right_With_Time "Sheet1", "Picture1", 20, 400
End Sub

'time_gap represent the time slept after moving
Sub Move_Right_With_Time(worksheet As String, shape As String, time_gap As Long, distance As Double)
Dim start_timer As Long

Worksheets(worksheet).Shapes(shape).IncrementLeft distance

start_timer = GetTickCount
While GetTickCount < start_timer + time_gap
DoEvents
Wend

Sleep time_gap

End Sub

1 Answers1

0

Do it like this instead:

Sub Button1_Click()
  Dim dt as Date

  dt = DateAdd("s", 2, Now) ' 2 seconds
  Worksheets("Sheet1").Shapes("Picture 2").IncrementLeft 1000

  Do Until Now > dt
    DoEvents
  Loop

  ' more stuff here after the waiting is done
  Worksheets("Sheet1").Shapes("Picture 2").IncrementLeft 2000

End Sub
braX
  • 11,506
  • 5
  • 20
  • 33
  • Thank you very much, this works perfectly. However, when I am trying to test this with a small interval (replace 2 with 0.25, for example), it seems like the smallest actual interval as it runs is about 0.5 seconds. Are there any ways to further reduce this interval, or it's just a hardware issue? – Shampooooo Dec 18 '19 at 12:15
  • Possible, but a bit more complex - https://stackoverflow.com/questions/47951860/vba-string-with-milliseconds-to-date – braX Dec 18 '19 at 16:40
  • The link seems to be formatting and converting a string to a number instead of dealing with Date (or did I misunderstood?)......While I made another update using WinAPI GetTickCount to deal with DoEvent loop, and now it feels like working with smaller time interval. – Shampooooo Dec 19 '19 at 02:12