web-dev-qa-db-fra.com

Comment donner un délai inférieur à une seconde dans Excel vba?

je veux répéter un événement après une certaine durée qui 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 retard de dire une demi-seconde?

excel-vbavbaexcel
25
Rito

Vous pouvez utiliser un appel API et une veille:

Mettez ceci en haut de votre module:

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Ensuite, vous pouvez l'appeler dans une procédure comme celle-ci:

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
Doug Glancy

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) soit une minute

donc 1/(24 * 60 * 60 * 2) est 1/2 seconde

Vous devez utiliser un point décimal quelque part pour forcer un nombre à virgule flottante.

La source

Je ne sais pas si cela vaudra le coup pendant quelques millisecondes

Application.Wait (Now + 0.000001)
14
graham nelson

appelez waitfor (.005) 

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

    Do while timer < sngsec
        DoEvents
   Loop
End sub

source Délais de synchronisation dans VBA

11
user4232305

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
Nam

De toute évidence, un ancien poste, mais cela semble fonctionner pour moi ....

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

Divisez par tout ce dont vous avez besoin. Un dixième, un centième, etc. semblent tous fonctionner. En supprimant la "division par", la macro prend plus de temps à s'exécuter, donc sans erreur, je dois croire que cela fonctionne.

0
RollTideMike

Sinon, vous pouvez créer votre propre fonction puis l'appeler. 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
VilhelmP

Aucune réponse ne m'a aidé, alors je construis cela.

'   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

Remarque: Dans Excel 2007, Now() envoie le nombre de secondes avec le nombre de décimales à la seconde; j'utilise donc Timer() pour obtenir des millisecondes.

Remarque: Application.Wait() accepte les secondes et non les sous (i.e. Application.Wait(Now())Application.Wait(Now()+100*millisecond)))

Remarque: Application.Wait() ne permet pas au système d’exécuter un autre programme, mais réduit considérablement les performances. Préférez l'utilisation de DoEvents.

0
karkael
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 vous appréciez.

modifier:

voici un sans fonctions supplémentaires, pour les gens qui aiment ça plus vite

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
matan justme