vendredi 27 février 2015

Excel VBA Polling/ preventing code from running more than once in specified time

I have another code thats running in the background, and when certain conditions are met it will call the sub Alert. There are multiple scenarios that call this code out though and whats happening right now is Alert starts running more frequently then the 3 seconds I would like it to (indicated by AlertTIMER). Here's my attempt to solve the issue



Sub Alert()
If Sheets("Sheet1").CommandButton21.Enabled = False And Sheets("Sheet1").CommandButton22.Enabled = False And Sheets("Sheet1").CommandButton25.Enabled = False Then
Beep
Application.Speech.Speak ("Part is done")
Beep
Call AlertTIMER
Exit Sub

ElseIf Sheets("Sheet1").CommandButton21.Enabled = False And Sheets("Sheet1").CommandButton22.Enabled = False Then
Beep
Application.Speech.Speak ("Part is done")
Beep
Call AlertTIMER
Exit Sub

ElseIf Sheets("Sheet1").CommandButton21.Enabled = False And Sheets("Sheet1").CommandButton25.Enabled = False Then
Beep
Application.Speech.Speak ("Part is done")
Beep
Call AlertTIMER
Exit Sub

ElseIf Sheets("Sheet1").CommandButton22.Enabled = False And Sheets("Sheet1").CommandButton25.Enabled = False Then
Beep
Application.Speech.Speak ("Part is done")
Beep
Call AlertTIMER
Exit Sub

ElseIf Sheets("Sheet1").CommandButton21.Enabled = False Then
Beep
Application.Speech.Speak ("Part is done")
Beep
Call AlertTIMER
Exit Sub

ElseIf Sheets("Sheet1").CommandButton22.Enabled = False Then
Beep
Application.Speech.Speak ("Part is done")
Beep
Call AlertTIMER
Exit Sub

ElseIf Sheets("Sheet1").CommandButton25.Enabled = False Then
Beep
Application.Speech.Speak ("Part is done")
Beep
Call AlertTIMER
Exit Sub
Else
Exit Sub
End If

End Sub

Sub AlertTIMER()
Dim ACountDown As Date
ACountDown = Now + TimeValue("00:00:03")
Application.OnTime ACountDown, "Alert"
End Sub


Clearly it did not work haha. Originally i had one if Statement with or's instead of the ands... but that was not working either. Any help?


EDIT:


I believe what is happening is in the AlertTIMER sub it calculates the value ACountDown. In example lets say it is first triggered at 12:00:00 AM ( ACountDown will = 12:00:03 AM) and then submts it to Application.OnTime as that value (12:00:03 AM). When another event is triggered lets say at 12:00:01 AM it calculates ACountDown as 12:00:04 AM and then submits it to Application.OnTime as that value (12:00:04 AM). So in the end I have "Alert" being triggered at 12:00:03 and 12:00:04. One way to solve this would be if the code kept ACountDown as a variable until "Alert" is triggered from Application.OnTime??. So with the previous example it calculates 12:00:03 AM first for ACountDown, but then is reset to 12:00:04 AM when the second trigger comes in. At 12:00:04 AM it then triggers "Alert" via Application.OnTime - only running it once.


EDIT2:


Another way to work around this, if there is a way to accomplish this, would be to check if there is an Application.OnTime running/active if so then cancel it. The code would look like this:



Sub AlertTIMER()
Dim ACountDown As Date

If Application.OnTime(, "Alert") Is Nothing Then
Else
Application.OnTime ACountDown, "Alert", , False
End If

ACountDown = Now + TimeValue("00:00:03")
Application.OnTime ACountDown, "Alert"
End Sub


But If Application.OnTime(, "Alert") Is Nothing Then returns an error... as you can't check to see if it is nothing since it's not an object. Any thought on how maybe I could get this to work?


Aucun commentaire:

Enregistrer un commentaire