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?

24
demandé sur Community 2013-09-04 03:20:40

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
20
répondu Doug Glancy 2013-09-04 01:17:04

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

Source

vous ne savez Pas si cela va fonctionner vaut le coup pour millisecondes

Application.Wait (Now + 0.000001) 
13
répondu graham nelson 2017-08-29 08:17:19

appel waitfor(.005)

Sub WaitFor(NumOfSeconds As Single)
    Dim SngSec as Single
    SngSec=Timer + NumOfSeconds

    Do while timer < sngsec
        DoEvents
   Loop
End sub

source Calendrier des Retards dans VBA

11
répondu user4232305 2017-05-23 12:02:16

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
4
répondu Nam 2014-10-02 20:13:07
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
0
répondu matan justme 2016-12-06 18:28:12

é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.

0
répondu RollTideMike 2017-12-13 18:29:40

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 .

0
répondu karkael 2018-01-05 15:57:55

, 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
0
répondu VilhelmP 2018-08-07 17:21:04