Comment donner un délai de moins d'une seconde dans excel vba?
je tiens à répéter un événement après une certaine durée est inférieure à 1 seconde. J'ai essayé d'utiliser le code suivant
Application.wait Now + TimeValue ("00:00:01")
mais ici le délai minimum est d'une seconde. Comment donner un délai d'une demi-seconde?
8 réponses
vous pouvez utiliser un appel API et dormir:
mettez ceci en haut de votre module:
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
, Alors vous pouvez l'appeler dans une procédure comme ceci:
Sub test()
Dim i As Long
For i = 1 To 10
Debug.Print Now()
Sleep 500 'wait 0.5 seconds
Next i
End Sub
j'ai trouvé ceci sur un autre site pas sûr si cela fonctionne ou pas.
Application.Wait Now + 1/(24*60*60.0*2)
la valeur numérique 1 = 1 jour
1/24 est une heure
1/(24*60) est d'une minute
so 1/(24*60*60*2) est 1/2 seconde
vous devez utiliser un point décimal quelque part pour forcer un nombre de virgule flottante
vous ne savez Pas si cela va fonctionner vaut le coup pour millisecondes
Application.Wait (Now + 0.000001)
appel waitfor(.005)
Sub WaitFor(NumOfSeconds As Single)
Dim SngSec as Single
SngSec=Timer + NumOfSeconds
Do while timer < sngsec
DoEvents
Loop
End sub
j'ai essayé ceci et cela fonctionne pour moi:
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
exemple:
call TimeDelay(1.9,23.9,59.9,59.9999999)
hopy que vous aimez.
edit:
voici un sans aucune fonction supplémentaire, pour les gens qui aiment qu'il soit plus rapide
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
évidemment un vieux poste, mais cela semble fonctionner pour moi....
Application.Wait (Now + TimeValue("0:00:01") / 1000)
Divisez par ce dont vous avez besoin. Un dixième, un centième, etc. tous semblent fonctionner. En supprimant la partie" diviser par", la macro prend plus de temps à exécuter, donc, sans erreurs présentes, je dois croire que cela fonctionne.
aucune réponse ne m'a aidé, donc je construis ceci.
' 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
Note: dans Excel 2007, Now()
envoyer Double avec décimales à secondes, donc j'utilise Timer()
pour obtenir millisecondes.
Note : Application.Wait()
accepter secondes et pas de sous (c'est à dire Application.Wait(Now())
↔ Application.Wait(Now()+100*millisecond))
)
Note: Application.Wait()
ne permet pas au système d'exécuter un autre programme mais à peine réduire les performances. Préférez l'utilisation de DoEvents
.
, Sinon vous pouvez créer votre propre fonction d'appel. Il est important d'utiliser Double
Function sov(sekunder As Double) As Double
starting_time = Timer
Do
DoEvents
Loop Until (Timer - starting_time) >= sekunder
End Function