Msgbox temporaire / Popup - problème avec timout
Bonjour
Je profite de mon problème et de mes recherches pour vous faire part de ce que j'ai pu trouver.
Il semble possible que le code suivant ne marche pas à tous les coups à partir d'Excel 2007. (J'ai le problème sur Excel 2010.)
Code:
CreateObject("Wscript.shell").Popup "Le Message", 3, "Le Titre", vbExclamation
Issu de la FAQ Excel (par SilkyRoad)
En fonction de où le code est placé, cela marche ou ne marche pas.
Lorsque ça ne marche pas, le message apparait mais le décompte ne se fait pas, il faut cliquer sur OK.
Le problème a été soulevé sur un site en anglais (lien)
Il existe plusieurs alternatives:
Code:
1
2
3
4
5
6
| Sub test_msgbox_temp_1()
CreateObject("WScript.Shell").Run "mshta.exe vbscript:close(CreateObject(""WScript.Shell"").Popup(""Test"",3,""Real%20Time%20Status%20Message""))"
MsgBox "test"
End Sub |
Le Popup marchera, par contre le code continue... Donc il faudrait coupler ça avec
Code:
Application.Wait Now + TimeValue("00:00:03")
par exemple ?
La deuxième solution du site est la suivante:
Code:
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
| 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_temp_2()
Const cmsg As String = "Msgbox avec tempo de 2s"
Const cTitle As String = "Popup"
Dim retval As Long
retval = MessageBoxTimeout(FindWindow(vbNullString, Title), cmsg, cTitle, 4, 0, 2000) 'en ms
If retval <> 7 Then
'ne rien faire
End If
MsgBox "test"
End Sub |
Avez-vous d'autres solutions ou une explication du bug ?
