1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77
| Declare Function MessageBoxTimeout Lib "user32.dll" Alias "MessageBoxTimeoutA" ( _
ByVal hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal uType As Long, _
ByVal wLanguageID As Long, _
ByVal lngMilliseconds As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Public Sub test_msgbox_temporise()
Const cmsg As String = "Msgbox avec tempo"
Const cTitle As String = "Popup"
Dim retval As Long
'vbOKOnly 0 Bouton OK uniquement (valeur par défaut)
'vbOKCancel 1 Boutons OK et Annuler
'vbAbortRetryIgnore 2 Boutons Abandonner, Répéter et Ignorer
'vbYesNoCancel 3 Boutons Oui, Non et Annuler
'vbYesNo 4 Boutons Oui et Non
'vbRetryCancel 5 Boutons Répéter et Annuler
'vbCritical 16 Message critique
'vbQuestion 32 Requête d'avertissement
'vbExclamation 48 Message d'avertissement
'vbInformation 64 Message d'information
'vbDefaultButton1 0 Le premier bouton est le bouton par défaut (valeur par défaut)
'vbDefaultButton2 256 Le deuxième bouton est le bouton par défaut
'vbDefaultButton3 512 Le troisième bouton est le bouton par défaut
'vbDefaultButton4 768 Le quatrième bouton est le bouton par défaut
retval = msgbox_temporise(cmsg, vbYesNoCancel + vbExclamation + vbDefaultButton2, cTitle, 2000) 'en ms
Select Case retval
'Constante Valeur Bouton choisi
'vbOK 1 Bouton OK
'vbCancel 2 Bouton Annuler
'vbAbort 3 Bouton Abandonner
'vbRetry 4 Bouton Répéter
'vbIgnore 5 Bouton Ignorer
'vbYes 6 Bouton Oui
'vbNo 7 Bouton Non
Case 1
RETOUR = "OK"
Case 2
RETOUR = "Annuler"
Case 3
RETOUR = "Abandonner"
Case 4
RETOUR = "Répéter"
Case 5
RETOUR = "Ignorer"
Case 6
RETOUR = "OUI"
Case 7
RETOUR = "NON"
Case 32000
RETOUR = "timeout"
Case Else
RETOUR = retval
End Select
'ne rien faire
MsgBox RETOUR
End Sub
Public Function msgbox_temporise(cmsg As String, Boutons As Integer, cTitle As String, MilliSec)
Dim retval As Long
If MilliSec < 1000 Then MilliSec = 3000
retval = MessageBoxTimeout(FindWindow(vbNullString, Title), cmsg, cTitle, Boutons, 0, MilliSec) 'en ms
msgbox_temporise = retval
End Function |
Partager