Retrasos de tiempo en VBA

Me gustaría un retraso de 1 segundo en mi código. A continuación se muestra el código que estoy tratando de hacer este retraso. Creo que sondea la fecha y la hora del sistema operativo y espera hasta que los tiempos coincidan. Estoy teniendo un problema con la demora. Creo que no sondea el tiempo cuando coincide con el tiempo de espera y simplemente se queda allí y se congela. Solo se congela aproximadamente el 5% del tiempo que ejecuto el código. Me preguntaba sobre Application.Wait y si hay una manera de verificar si el tiempo de votación es mayor que el tiempo de espera.

newHour = Hour(Now()) newMinute = Minute(Now()) newSecond = Second(Now()) + 1 waitTime = TimeSerial(newHour, newMinute, newSecond) Application.Wait waitTime 

Uso esta pequeña función para VBA.

 Public Function Pause(NumberOfSeconds As Variant) On Error GoTo Error_GoTo Dim PauseTime As Variant Dim Start As Variant Dim Elapsed As Variant PauseTime = NumberOfSeconds Start = Timer Elapsed = 0 Do While Timer < Start + PauseTime Elapsed = Elapsed + 1 If Timer = 0 Then ' Crossing midnight PauseTime = PauseTime - Elapsed Start = 0 Elapsed = 0 End If DoEvents Loop Exit_GoTo: On Error GoTo 0 Exit Function Error_GoTo: Debug.Print Err.Number, Err.Description, Erl GoTo Exit_GoTo End Function 

Si está en Excel VBA puede usar lo siguiente.

 Application.Wait(Now + TimeValue("0:00:01")) 

(La cadena de tiempo debe verse como H: MM: SS.)

Puedes copiar esto en un módulo:

 Sub WaitFor(NumOfSeconds As Long) Dim SngSec as Long SngSec=Timer + NumOfSeconds Do while timer < sngsec DoEvents Loop End sub 

y cuando quiera aplicar la pausa, escriba:

 Call WaitFor(1) 

¡Espero que eso ayude!

¿Has intentado usar Sleep?

Hay un ejemplo AQUÍ (copiado a continuación):

 Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private Sub Form_Activate() frmSplash.Show DoEvents Sleep 1000 Unload Me frmProfiles.Show End Sub 

Tenga en cuenta que podría congelar la aplicación durante el tiempo elegido.

Otra variante de la respuesta de Steve Mallorys, específicamente necesitaba que se escapara y hacer cosas mientras esperaba y 1 segundo era demasiado largo.

 'Wait for the specified number of milliseconds while processing the message pump 'This allows excel to catch up on background operations Sub WaitFor(milliseconds As Single) Dim finish As Single Dim days As Integer 'Timer is the number of seconds since midnight (as a single) finish = Timer + (milliseconds / 1000) 'If we are near midnight (or specify a very long time!) then finish could be 'greater than the maximum possible value of timer. Bring it down to sensible 'levels and count the number of midnights While finish >= 86400 finish = finish - 86400 days = days + 1 Wend Dim lastTime As Single lastTime = Timer 'When we are on the correct day and the time is after the finish we can leave While days >= 0 And Timer < finish DoEvents 'Timer should be always increasing except when it rolls over midnight 'if it shrunk we've gone back in time or we're on a new day If Timer < lastTime Then days = days - 1 End If lastTime = Timer Wend End Sub 

La función del temporizador también se aplica a Access 2007, Access 2010, Access 2013, Access 2016, desarrollador de Access 2007, desarrollador de Access 2010, desarrollador de Access 2013. Inserta este código para pausar el tiempo por cierta cantidad de segundos

 T0 = Timer Do Delay = Timer - T0 Loop Until Delay = 1 'Change this value to pause time in second 

El acceso siempre puede usar el procedimiento de Excel, siempre que el proyecto tenga la referencia de objeto Microsoft Excel XX.X incluida :

 Call Excel.Application.Wait(DateAdd("s",10,Now())) 

Tu código solo crea un tiempo sin una fecha. Si su suposición es correcta, cuando ejecute la aplicación. Espere el tiempo realmente alcanzado ese tiempo. Esperará exactamente 24 horas. También me preocupa un poco llamar ahora () varias veces (¿podría ser diferente?) Cambiaría el código a

  application.wait DateAdd("s", 1, Now) 

Utilicé la respuesta de Steve Mallory, pero le tengo miedo al temporizador nunca o al menos a veces no va al 86400 ni al 0 (cero) nítido (MS Access 2013). Entonces modifiqué el código. Cambié la condición de medianoche a “If Timer> = 86399 Then” y agregué el corte del ciclo “Exit Do” de la siguiente manera:

 Public Function Pause(NumberOfSeconds As Variant) On Error GoTo Error_GoTo Dim PauseTime As Variant Dim Start As Variant Dim Elapsed As Variant PauseTime = NumberOfSeconds Start = Timer Elapsed = 0 Do While Timer < Start + PauseTime Elapsed = Elapsed + 1 If Timer >= 86399 ' Crossing midnight ' PauseTime = PauseTime - Elapsed ' Start = 0 ' Elapsed = 0 Exit Do End If DoEvents Loop Exit_GoTo: On Error GoTo 0 Exit Function Error_GoTo: Debug.Print Err.Number, Err.Description, Erl GoTo Exit_GoTo End Function 

El temporizador de Windows devuelve centésimas de segundo … La mayoría de las personas solo usa segundos porque en el temporizador de la plataforma Macintosh devuelve números enteros.

Con créditos debidos y gracias a Steve Mallroy.

Tuve problemas de medianoche en Word y el código siguiente funcionó para mí

 Public Function Pause(NumberOfSeconds As Variant) ' On Error GoTo Error_GoTo Dim PauseTime, Start Dim objWord As Word.Document 'PauseTime = 10 ' Set duration in seconds PauseTime = NumberOfSeconds Start = Timer ' Set start time. If Start + PauseTime > 86399 Then 'playing safe hence 86399 Start = 0 Do While Timer > 1 DoEvents ' Yield to other processes. Loop End If Do While Timer < Start + PauseTime DoEvents ' Yield to other processes. Loop End Function 
Intereting Posts