DoEvents & Время

Sub timeout(interval!)
    Dim tmEnd!
    tmEnd = Timer + interval
    DoEvents
    While Timer < tmEnd
    Wend
End Sub

DoEvents
DoEvents

Sub timeout(duration_ms As Double)
       start_time = Timer
       Do
       DoEvents
       Loop Until (Time - start_time) >= duration_ms
End Sub

Sub shiftface()
    Dim cnt!, tmEnd!
    Const step! = 1.7
    Const interval! = 0.005
    With Shapes("Smiley Face 3")
      cnt = .Left
      Do
        DoEvents
        DoEvents
        cnt = cnt + step
        .Left = cnt
        tmEnd = Timer + interval
        While Timer < tmEnd
'            DoEvents
        Wend
      Loop Until cnt > 300
      .Left = 0
    End With
End Sub

     Do
        DoEvents
'        DoEvents
        cnt = cnt + step
        .Left = cnt
        tmEnd = Timer + interval
        While Timer < tmEnd
'            DoEvents
        Wend
     Loop Until cnt > 300

Time = "23:59:59"
     Do
        DoEvents
'        DoEvents
        cnt = cnt + step
        .Left = cnt
        tmEnd = Timer + interval
        While Timer < tmEnd
'            DoEvents
        Wend
     Loop Until cnt > 300

        dim tm#
        tm=Timer
        tmEnd = Tm + interval
        do
          if timer<tm then tmEnd=tmEnd-86400
          tm=Timer
        loop While tm< tmEnd

With Sheets("Лист1").Shapes("Sm")