web-dev-qa-db-fra.com

Retards de synchronisation dans VBA

Je voudrais un délai de 1 seconde dans mon code. Vous trouverez ci-dessous le code que j'essaie de créer ce délai. Je pense qu'il interroge la date et l'heure hors du système d'exploitation et attend jusqu'à ce que les heures correspondent. J'ai un problème avec le retard. Je pense qu’il ne vérifie pas le moment où il correspond au temps d’attente et qu’il reste en place et qu’il se fige. Cela gèle environ 5% du temps que je lance le code. Je m'interrogeais sur Application.Wait et sur la possibilité de vérifier si le temps d'interrogation est supérieur au temps d'attente.

   newHour = Hour(Now())
   newMinute = Minute(Now())
   newSecond = Second(Now()) + 1
   waitTime = TimeSerial(newHour, newMinute, newSecond)
   Application.Wait waitTime
vbatimerwaitpausetimedelay
15
Lagg Master

J'utilise cette petite fonction pour VBA. 

Public Function Pause(NumberOfSeconds As Variant)
    On Error GoTo Error_GoTo

    Dim PauseTime As Variant
    Dim Start As Variant
    Dim Elapsed As Variant

    PauseTime = NumberOfSeconds
    Start = Timer
    Elapsed = 0
    Do While Timer < Start + PauseTime
        Elapsed = Elapsed + 1
        If Timer = 0 Then
            ' Crossing midnight
            PauseTime = PauseTime - Elapsed
            Start = 0
            Elapsed = 0
        End If
        DoEvents
    Loop

Exit_GoTo:
    On Error GoTo 0
    Exit Function
Error_GoTo:
    Debug.Print Err.Number, Err.Description, Erl
    GoTo Exit_GoTo
End Function
22
Steve Mallory

Si vous êtes dans Excel VBA, vous pouvez utiliser ce qui suit.

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

(La chaîne de temps doit ressembler à H: MM: SS.)

36
TheFuzzyGiggler

Vous pouvez copier ceci dans un module:

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

Do while timer < sngsec
DoEvents
Loop

End sub

et chaque fois que vous voulez appliquer la pause, écrivez:

Call WaitFor(1)

J'espère que ça aide!

11
Financial Economist

Avez-vous essayé d'utiliser Sleep?

Voici un exemple ICI (copié ci-dessous):

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

Private Sub Form_Activate()    

frmSplash.Show
DoEvents
Sleep 1000
Unload Me
frmProfiles.Show

End Sub

Notez que l'application pourrait être gelée pendant la durée choisie.

6
Tiago Cardoso

La fonction Minuteur s'applique également à Access 2007, Access 2010, Access 2013, Access 2016, Access 2007 Developer, Access 2010 Developer, Access 2013 Developer. Insérez ce code pour faire une pause de quelques secondes

T0 = Timer
Do
    Delay = Timer - T0
Loop Until Delay = 1 'Change this value to pause time in second
2
Anastasiya-Romanova 秀

Access peut toujours utiliser la procédure Excel tant que le projet comporte l'objet référence Microsoft Excel XX.X inclus :

Call Excel.Application.Wait(DateAdd("s",10,Now()))
2
user3298002

Une autre variante de la réponse de Steve Mallorys, j'avais spécifiquement besoin d'Excel pour s'exécuter et tout faire en attente et une seconde était trop longue.

'Wait for the specified number of milliseconds while processing the message pump
'This allows Excel to catch up on background operations
Sub WaitFor(milliseconds As Single)

    Dim finish As Single
    Dim days As Integer

    'Timer is the number of seconds since midnight (as a single)
    finish = Timer + (milliseconds / 1000)
    'If we are near midnight (or specify a very long time!) then finish could be
    'greater than the maximum possible value of timer. Bring it down to sensible
    'levels and count the number of midnights
    While finish >= 86400
        finish = finish - 86400
        days = days + 1
    Wend

    Dim lastTime As Single
    lastTime = Timer

    'When we are on the correct day and the time is after the finish we can leave
    While days >= 0 And Timer < finish
        DoEvents
        'Timer should be always increasing except when it rolls over midnight
        'if it shrunk we've gone back in time or we're on a new day
        If Timer < lastTime Then
            days = days - 1
        End If
        lastTime = Timer
    Wend

End Sub
2
James Barrass

Votre code crée uniquement une heure sans date. Si votre hypothèse est correcte, attendez 24 heures exactement lorsque vous exécutez l'application.wait. Je m'inquiète aussi un peu d’appeler maintenant () plusieurs fois (pourrait être différent?) Je changerais le code en 

 application.wait DateAdd("s", 1, Now)
1
Eddy

J'ai utilisé la réponse de Steve Mallory, mais je crains que le chronomètre ne passe jamais ou du moins parfois ne va pas à 86400 ni 0 (zéro) forte (MS Access 2013). J'ai donc modifié le code. J'ai changé la condition de minuit en "Si minuteur> = 86399 Alors" Et ajouté la coupure de boucle "Exit Do" comme suit:

Public Function Pause(NumberOfSeconds As Variant)
    On Error GoTo Error_GoTo

    Dim PauseTime As Variant
    Dim Start As Variant
    Dim Elapsed As Variant

    PauseTime = NumberOfSeconds
    Start = Timer
    Elapsed = 0
    Do While Timer < Start + PauseTime
        Elapsed = Elapsed + 1
        If Timer >= 86399
            ' Crossing midnight
            ' PauseTime = PauseTime - Elapsed
            ' Start = 0
            ' Elapsed = 0
            Exit Do
        End If
        DoEvents
    Loop

Exit_GoTo:
    On Error GoTo 0
    Exit Function
Error_GoTo:
    Debug.Print Err.Number, Err.Description, Erl
    GoTo Exit_GoTo
End Function
1
Miroslav Kovarik

Pour MS Access: Lancez un formulaire masqué avec le jeu Me.TimerInterval et un gestionnaire d'événements Form_Timer. Mettez votre code à être retardé dans la routine Form_Timer - en quittant la routine après chaque exécution.

Par exemple.:

Private Sub Form_Load()
    Me.TimerInterval = 30000 ' 30 sec
End Sub

Private Sub Form_Timer()

    Dim lngTimerInterval  As Long: lngTimerInterval = Me.TimerInterval

    Me.TimerInterval = 0

    '<Your Code goes here>

    Me.TimerInterval = lngTimerInterval
End Sub

"Votre code va ici" sera exécuté 30 secondes après l'ouverture du formulaire et 30 secondes après chaque exécution ultérieure.

Fermez le formulaire caché lorsque vous avez terminé.

0
Jim

Sous Windows, le chronomètre renvoie des centièmes de seconde ... La plupart des gens n'utilisent que des secondes car, sur la plate-forme Macintosh, le chronomètre renvoie des nombres entiers. 

0
Peter

Avec les crédits Due et merci à Steve Mallroy.

J'ai eu des problèmes de minuit dans Word et le code ci-dessous a fonctionné pour moi

Public Function Pause(NumberOfSeconds As Variant)
 '   On Error GoTo Error_GoTo

    Dim PauseTime, Start
    Dim objWord As Word.Document

    'PauseTime = 10 ' Set duration in seconds
    PauseTime = NumberOfSeconds
    Start = Timer ' Set start time.

    If Start + PauseTime > 86399 Then 'playing safe hence 86399

    Start = 0

    Do While Timer > 1
        DoEvents ' Yield to other processes.
    Loop

    End If

    Do While Timer < Start + PauseTime
        DoEvents ' Yield to other processes.
    Loop

End Function
0
Ateeq