J'avais trouvé ca une fois pour faire une pause dans un programme. par contre c'est brut de brut...C'est 5 possibilités de pause différente dans un programme mais m'en suis jamais servi. good luck
Attribute VB_Name = "TemporisationsEtPauses"
'J'ai découvert que lorsqu'on utilise l'api GetInputState
'au lieu de la fonction vb DoEvents, l'interception des évenements est
'plus rapide... ainsi les répétitions s'effectuent aussi plus rapidement.
'Alors, dans vos structures de répétition (ex. for i=1 to 2000), remplacer
' DoEvents
'Par
' If GetInputState Then DoEvents
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function GetInputState Lib "user32" () As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim T1 As SYSTEMTIME, T2 As SYSTEMTIME, T3 As SYSTEMTIME
'Exemple de pause avec Sleep:
Sub Pause10000()
MsgBox Time
Sleep 10000
MsgBox Time
End Sub
Public Sub PauseGetSysTime(Duree As Double, AutoDoEvents As Boolean)
If Duree > 30000 Then Exit Sub
Dim TpsEcoule 'Temps écoulé
GetSystemTime T2
Do
GetSystemTime T1
If T1.wMilliseconds < T2.wMilliseconds Then _
T1.wMilliseconds = T1.wMilliseconds + 1000: T1.wSecond = T1.wSecond - 1
T3.wMilliseconds = T1.wMilliseconds - T2.wMilliseconds
If T1.wSecond < T2.wSecond Then _
T1.wSecond = T1.wSecond + 60 ': T1.wMinute = T1.wMinute - 1
T3.wSecond = T1.wSecond - T2.wSecond
TpsEcoule = T3.wMilliseconds + T3.wSecond * 1000 _
+ T3.wMinute * 60 * 1000 + T3.wHour * 60 * 60 * 1000
If TpsEcoule >= Duree Then Exit Sub
If AutoDoEvents = True Then DoEvents
Loop
End Sub
'********************************************************************************************
' Name : xWait
' Purpose : Fait une pause de X secondes
' sans bloquer les autres applications ou fonctions.
' Syntax : xWait(MilsecToWait)
' Parameters : MilsecToWait : Time to wait in millisecond
'********************************************************************************************
Public Sub PauseGetTickCount(ByVal MilsecToWait As Long)
Dim lngEndingTime As Long
lngEndingTime = GetTickCount() + (MilsecToWait)
Do While GetTickCount() < lngEndingTime
DoEvents
Loop
End Sub
Sub PauseTimer(ByVal nSecond As Single)
Dim t0 As Single
'temps de référence
t0 = Timer
'boucle d'attente
Do While Timer - t0 < nSecond
Dim dummy As Integer
dummy = DoEvents()
'si on dépasse minuit,il faut
'retrancher un jour
If Timer < t0 Then
t0 = t0 - 24 * 60 * 60
End If
Loop
End Sub
Sub PauseDateDiff(NbSec As Long)
Dim tempotemp
tempotemp = Now()
Do Until (DateDiff("s", tempotemp, Now()) > NbSec)
DoEvents
Loop
End Sub
'Sub test()
' MsgBox "début"
' PauseDateDiff 5
' MsgBox "fin"
'End Sub