PDA

View Full Version : Solved: Add a timer to Macro



Tenspeed39355
12-12-2008, 07:47 PM
Good afternoon guys. What would the command I can use in a Macro
so the Macro would automaticly repete the Macro every two minutes and
where in the Macro would I put the command? Thanks for your help.
I can set the Macro up using the Record part of the Macro.
Using the record part of the macro I will set up a sort so all I think I need is the timer to automaticly run the macro every two minutes.
Thanks
Max

GTO
12-12-2008, 10:11 PM
Greetings Tenspeed,

See the VBA Help Topic for details. You can use Application.OnTime to set a recurse. Here's example code and I attached the example wb so you can see it in action...

Hope this helps,

Mark

In a standard module...

Option Explicit
Dim sngEndTime As Single
Dim bolLimitActivated As Boolean
'// See ThisWorkbook module.//
Public myTime As Date
Public bolinProcess As Boolean
Sub StartTest()
'// As the boolean starts out FALSE, we'll use this to initialize sngEndTime. I //
'// chose 2 minutes, change to suit. //
If Not bolLimitActivated Then
'// limit recursion to 2 minutes...//
sngEndTime = Timer + 120
End If

'// Change to TRUE, so that as the sub recurses (calls itself) thru the use of //
'// Application.OnTime, the end time limitation stays good. //
bolLimitActivated = True

'// Basically, this means IF NOW is less than our starting time plus three minutes //
If Timer < sngEndTime Then

'// keep TRUE as long as we have a timer running. //
bolinProcess = True

'// Then show the form...//
frmEx.Show
'// and set a time to be used for OnTime. The reason we are committing this to //
'// a Public variable instead of inserting it directly into OnTime, is so that //
'// we have it stored... This way, we can use myTime to disable OnTime in case //
'// the user closes the workbook. (See ThisWorkbook.BeforeClose)
myTime = Format(Now + TimeValue("00:00:30"), "hh:mm:ss")
'// Use OnTime to recurse to the Sub. //
Application.OnTime myTime, "StartTest"
Else
'// Set to FALSE so that BeforeClose won't error. //
bolinProcess = False
'// For the example, notify that the test is over. //
MsgBox "Time Limiter Reached", 0, ""

End If
End Sub
'// ... a delay I use. Used within the form for this example. //
Function Delay(Optional SecondFraction As Single = 0.2)
Dim sngTimeHack As Single, dtmDate As Date
sngTimeHack = Timer: dtmDate = Date

If sngTimeHack + SecondFraction < 86400 Then
Do
DoEvents
Loop While Timer < (sngTimeHack + SecondFraction)
Else
If dtmDate = Date Then
Do
DoEvents
Loop While dtmDate = Date
End If

sngTimeHack = (sngTimeHack + SecondFraction) - 86400
If DateAdd("d", 1, dtmDate) = Date Then
Do
DoEvents
Loop While Timer < sngTimeHack
End If
End If
End Function

In ThisWorkbook module...

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If bolinProcess Then Application.OnTime myTime, "StartTest", , False
End Sub

In a UserForm named frmEx, with one Label control named lblHello...

Option Explicit
Private Sub UserForm_Activate()
Dim bolSwitch As Boolean
Dim intLimit As Integer
Beep

'// a "cheapie" way of giving some "life" to our label, as long as the form is displayed//
Do While frmEx.Visible = True
'// We use intLimit to exit the loop and kill the userform after a bit... //
intLimit = intLimit + 1
If Not bolSwitch Then
lblHello.ForeColor = &HFF&
Else
lblHello.ForeColor = &HFF00&
End If

'// Toggle... So that label text will change color ea loop //
bolSwitch = Not bolSwitch

'// See function//
Delay 0.5

'// Bail out of loop, which leads to unloading form. //
If intLimit > 19 Then Exit Do

Loop
'// Release form from memory. //
Unload Me

End Sub

david000
12-13-2008, 09:45 PM
I like this thread...not to take away from the ostentatious sample code from the goat!
http://www.vbaexpress.com/forum/showthread.php?t=23110&highlight=timer

Tenspeed39355
12-14-2008, 04:55 PM
Hi thanks for your time with my problem. I found several that will work.
Good Job. I will rate this thread
Max