Quiero hacer un programa que se ejecute en bucle en segundo plano y opere en una consulta actualizable sin colgar Excel al mismo tiempo y cuando ocurra algo incorrecto, muestre un mensaje. Entonces, la única idea que funcionó para mí fue programar un procedimiento con Application.Ontime: la función se dice a sí misma cuándo volver a ejecutarse y se detiene cuando toco un control deslizante en la hoja de cálculo de Excel.
Pero tengo un problema que no puedo entender: ¿Por qué este cuadro de mensaje se muestra dos veces cada vez? El primer mensaje dice que es la hora (ahora) y el segundo justo después dice que es la hora (ahora + 20).
Public Sub sendingAmessage(schTime As Date) If Worksheets("MAIN").Range("ToggleText").Value = "MONITORING ON" Then AppActivate Application.Caption MsgBox (schTime) Application.OnTime schTime, "'sendingAmessage""" & DateAdd("s", 20, Now) & "'" End If End SubEste es un ejemplo de cómo volver a programar o tener un evento OnTime recurrente. Solo vea cuando llama a un procedimiento, necesita recuperar el sub OnTime del procedimiento.
Public RunWhen As Double Public Const cRunIntervalSeconds = 1 Public Const cRunWhat = "TheSub" ' the name of the procedure to run Public Password As String ' See top of Module to see public Variable and Constants Sub StartTimer() RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds) Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _ Schedule:=True End Sub Sub TheSub() ' Set Cell A1 to the Current Time ActiveSheet.Range("A1") = Time StartTimer ' Reschedule the procedure End Sub Sub StopTimer() On Error Resume Next Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _ Schedule:=False End SubSi también desea probar el método API de Windows, consulte a continuación: Solo tenga en cuenta que, a veces, tratar de cancelar esto es quisquilloso. Si guarda todo primero y luego, si cierra el libro de trabajo, un proceso fuera de Excel en el sistema operativo matará (forceclose) Excel, también si llama al procedimiento incorrecto como se menciona a continuación.
' Windows Timer functions via Windows API ' PtrSafe needed for API to work ' LongPtr is safe versions for 64 and 32 bit systems ' It converts between Long and LongLong types accordingly ' Note when an incorrect pointer is listed excel will likely crash ' If error External Error-Handlers will look to OS for help and kill excel.exe Option Explicit Public Declare PtrSafe Function SetTimer Lib "user32" ( _ ByVal HWnd As LongPtr, _ ByVal nIDEvent As LongPtr, _ ByVal uElapse As LongPtr, _ ByVal lpTimerFunc As LongPtr) As Long Public Declare PtrSafe Function KillTimer Lib "user32" ( _ ByVal HWnd As LongPtr, _ ByVal nIDEvent As LongPtr) As Long Public TimerID As Long Public TimerSeconds As Single Public bTimerEnabled As Boolean Public iCounter As Single Public bComplete As Boolean Public EventType As Integer Sub StartTimer() iCounter = 2 TimerID = SetTimer(0&, 0&, iCounter * 1000&, AddressOf TimerProc) End Sub Sub EndTimer() KillTimer 0&, TimerID bTimerEnabled = False bComplete = True End Sub Sub TimerProc(ByVal HWnd As LongPtr, ByVal uMsg As LongPtr, _ ByVal nIDEvent As LongPtr, ByVal dwTimer As LongPtr) Dim rc As Double On Error Resume Next Debug.Print iCounter ' Continue If iCounter <= 60 Then rc = On_Time.Range("F1045000").End(xlUp).Row + 1 On_Time.Range("F" & rc) = Time ThisWorkbook.Save End If ' EndTimer If iCounter > 60 Then EndTimer End If iCounter = iCounter + 1 End Sub