¿Cómo dar un retraso de menos de un segundo en excel vba?

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