Creating a VBA Timer

[Cah]

Hello, can someone please help me to make a timer that works in vba? I want to put it into a Corel Macro and have certain code run every half a second. I did some online searching and tried various things including trying a loop with a sleep but just managed to crash CorelDraw. Thanks

Chris

[HansV]

In MS Word and Excel, you can use Application.OnTime, but I don't know anything about VBA in CorelDraw, sorry.

[Cah]

Thanks Hans, I searched the vba help file for CorelDraw but Application.OnTime drew a blank.

[HansV]

This is kind of generic VBA; I don't know if it will run in CorelDraw. The minimum interval is 1 second though, and the interval won't be very precise.

Code: Select all

' The macro that calls another one repeatedly
Sub TimerTest()
  Dim dtmTime As Date
  Do
    dtmTime = Now
    Call Demo
    Do
      ' Give other processes a chance
      DoEvents
    Loop Until Now >= DateAdd("s", 1, dtmTime)
  Loop
End Sub

' The macro that you want to run repeatedly
Sub Demo()
  Beep
End Sub

[Cah]

Thanks Hans, it seems to work in CorelDraw, though as you said the timing is erratic. It might be usable for my purposes but I've just realised another problem. I would need to start the timer when the mouse pointer is within a defined area of the screen and stop it when the timer left that area. AutoHotkey can retrieve the mouse position but I haven't seen anything like that for VBA just a click which is a little different. Do you know anyway to check the current position of the mouse cursor? Thnaks again,

Chris

[HansV]

You could use a Windows API function to get the mouse coordinates, but is it really worth the trouble?

Code: Select all

Private Declare Function GetCursorPos Lib "user32" _
  (lpPoint As POINTAPI) As Long

Private Type POINTAPI
  x As Long
  y As Long
End Type

' The macro that calls another one repeatedly
Sub TimerTest()
  Dim dtmTime As Date
  Dim pt As POINTAPI
  Do
    dtmTime = Now
    Call GetCursorPos(pt)
    ' These are screen coordinates!
    If pt.x > 100 And pt.x < 200 And pt.y > 250 And pt.y < 400 Then
      Call Demo
    End If
    Do
      ' Give other processes a chance
      DoEvents
    Loop Until Now >= DateAdd("s", 1, dtmTime)
  Loop
End Sub

' The macro that you want to run repeatedly
Sub Demo()
  Beep
End Sub

[Jan Karel Pieterse]

You can also use the API timer to start a timed procedure, but it is risky, as it will fire the subroutine regardless of the application's state. It may crash your application if worse comes to worse.
See attached.

[BigKev]

Thanks Hans, I searched the vba help file for CorelDraw but Application.OnTime drew a blank.

There's an ActiveX Timer Control here http://activex.microsoft.com/control...86/ietimer.cab that was distributed by Microsoft with earlier versions of Internet Explorer, up to Version 4 if I remember correctly.

Maybe that will let you do what you want. Like Hans, I have no knowledge of Corel Draw VBA.

Chers,
Kevin

[Cah]

You could use a Windows API function to get the mouse coordinates, but is it really worth the trouble?

Thanks, Hans, I was able to adjust your example to work as I wanted. One more thing. Is there anyway to add the ability to stop and restart this timer? I know almost nothing about vba do loops. Thanks again,

Chris

[HansV]

You'd have to build in some condition - when it becomes true, exit the procedure. But I have no idea how to implement that in Corel Draw. Can you place a command button?

[Cah]

Thanks Hans, I can create vba forms and put buttons on them and I can add buttons into CorelDraw to run macros. I wondered about using a boolean operation but wasn't sure how to implement it with the do loop.

Chris

[HansV]

The idea is to declare a public variable at the top of a code module:

Public blnStop As Boolean

Check it in the TimerTest macro:

Code: Select all

Sub TimerTest()
  Dim dtmTime As Date
  Dim pt As POINTAPI
  ' Initialize blnStop
  blnStop = False
  Do
    dtmTime = Now
    Call GetCursorPos(pt)
    ' These are screen coordinates!
    If pt.x > 100 And pt.x < 200 And pt.y > 250 And pt.y < 400 Then
      Call Demo
    End If
    Do
      ' Give other processes a chance
      DoEvents
      If blnStop Then
        Exit Sub
      End If
    Loop Until Now >= DateAdd("s", 1, dtmTime)
  Loop
End Sub

Use a command button or similar to set blnStop to True:

Code: Select all

Private Sub cmdStop_Click()
  blnStop = True
End Sub

[Cah]

Code: Select all

    Do
      ' Give other processes a chance
      DoEvents
      If blnStop Then
        Exit Sub
      End If
    Loop Until Now >= DateAdd("s", 1, dtmTime)
  Loop
End Sub

Great, Hans! It was the position of the boolean inside the Do loop that I was missing when I tried it before. It is working now. Thank you very much.

Chris