Quiero repetir un evento después de una cierta duración que es menos de 1 segundo. Intenté usar el siguiente código
Application.wait Now + TimeValue ("00:00:01")
Pero aquí el tiempo mínimo de retardo es de un segundo. ¿Cómo dar un retraso de, digamos, medio seond?
Puedes usar una llamada API y dormir:
Pon esto en la parte superior de tu módulo:
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Entonces puede llamarlo en un procedimiento como este:
Sub test() Dim i As Long For i = 1 To 10 Debug.Print Now() Sleep 500 'wait 0.5 seconds Next i End Sub
Encontré esto en otro sitio no estoy seguro de si funciona o no.
Application.Wait Now + 1/(24*60*60.0*2)
el valor numérico 1 = 1 día
1/24 es una hora
1 / (24 * 60) es un minuto
entonces 1 / (24 * 60 * 60 * 2) es 1/2 segundo
Necesita usar un punto decimal en algún lugar para forzar un número de punto flotante
Fuente
No estoy seguro si esto funcionará, vale la pena intentarlo durante milisegundos
Application.Wait (Now + 0.000001)
llamada waitfor (.005)
Sub WaitFor(NumOfSeconds As Single) Dim SngSec as Single SngSec=Timer + NumOfSeconds Do while timer < sngsec DoEvents Loop End sub
fuente Demoras de tiempo en VBA
Lo intenté y me funciona:
Private Sub DelayMs(ms As Long) Debug.Print TimeValue(Now) Application.Wait (Now + (ms * 0.00000001)) Debug.Print TimeValue(Now) End Sub Private Sub test() Call DelayMs (2000) 'test code with delay of 2 seconds, see debug window End Sub
Public Function CheckWholeNumber(Number As Double) As Boolean If Number - Fix(Number) = 0 Then CheckWholeNumber = True End If End Function Public Sub TimeDelay(Days As Double, Hours As Double, Minutes As Double, Seconds As Double) If CheckWholeNumber(Days) = False Then Hours = Hours + (Days - Fix(Days)) * 24 Days = Fix(Days) End If If CheckWholeNumber(Hours) = False Then Minutes = Minutes + (Hours - Fix(Hours)) * 60 Hours = Fix(Hours) End If If CheckWholeNumber(Minutes) = False Then Seconds = Seconds + (Minutes - Fix(Minutes)) * 60 Minutes = Fix(Minutes) End If If Seconds >= 60 Then Seconds = Seconds - 60 Minutes = Minutes + 1 End If If Minutes >= 60 Then Minutes = Minutes - 60 Hours = Hours + 1 End If If Hours >= 24 Then Hours = Hours - 24 Days = Days + 1 End If Application.Wait _ ( _ Now + _ TimeSerial(Hours + Days * 24, Minutes, 0) + _ Seconds * TimeSerial(0, 0, 1) _ ) End Sub
ejemplo:
call TimeDelay(1.9,23.9,59.9,59.9999999)
Espero que disfrutes.
editar:
aquí hay uno sin funciones adicionales, para las personas que les gusta ser más rápido
Public Sub WaitTime(Days As Double, Hours As Double, Minutes As Double, Seconds As Double) If Days - Fix(Days) > 0 Then Hours = Hours + (Days - Fix(Days)) * 24 Days = Fix(Days) End If If Hours - Fix(Hours) > 0 Then Minutes = Minutes + (Hours - Fix(Hours)) * 60 Hours = Fix(Hours) End If If Minutes - Fix(Minutes) > 0 Then Seconds = Seconds + (Minutes - Fix(Minutes)) * 60 Minutes = Fix(Minutes) End If If Seconds >= 60 Then Seconds = Seconds - 60 Minutes = Minutes + 1 End If If Minutes >= 60 Then Minutes = Minutes - 60 Hours = Hours + 1 End If If Hours >= 24 Then Hours = Hours - 24 Days = Days + 1 End If Application.Wait _ ( _ Now + _ TimeSerial(Hours + Days * 24, Minutes, 0) + _ Seconds * TimeSerial(0, 0, 1) _ ) End Sub
Obviamente, una publicación anterior, pero parece funcionar para mí …
Application.Wait (Now + TimeValue("0:00:01") / 1000)
Divide por lo que necesites. Una décima, una centésima, etc., todo parece funcionar. Al eliminar la parte “dividir por”, la macro tarda más tiempo en ejecutarse, por lo tanto, sin errores presentes, tengo que creer que funciona.
Ninguna respuesta me ayudó, así que construyo esto.
' function Timestamp return current time in milliseconds. ' compatible with JSON or JavaScript Date objects. Public Function Timestamp () As Currency timestamp = (Round(Now(), 0) * 24 * 60 * 60 + Timer()) * 1000 End Function ' function Sleep let system execute other programs while the milliseconds are not elapsed. Public Function Sleep(milliseconds As Currency) If milliseconds < 0 Then Exit Function Dim start As Currency start = Timestamp () While (Timestamp () < milliseconds + start) DoEvents Wend End Function
Nota: En Excel 2007, Now()
envía Double con decimales a segundos, entonces uso Timer()
para obtener milisegundos.
Nota: Application.Wait()
acepta segundos y no debajo (es decir, Application.Wait(Now())
↔ Application.Wait(Now()+100*millisecond))
)
Nota: Application.Wait()
no permite que el sistema ejecute otro progtwig, pero apenas reduce el rendimiento. Prefiere el uso de DoEvents
.
De lo contrario, puede crear su propia función y luego llamarla. Es importante usar Double
Function sov(sekunder As Double) As Double starting_time = Timer Do DoEvents Loop Until (Timer - starting_time) >= sekunder End Function