Discussion :

[bucgif]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.Wait Now + TimeValue("00:00:03")

par exemple ?

La deuxième solution du site est la suivante:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 ?

[frankki]

Bonjour

J'ai eu ce problème, je ne connaissais pas cette soluce, par contre je l'ai essayée comme ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Sub test_msgbox_temp_1()
 
    CreateObject("WScript.Shell").Run "mshta.exe vbscript:close(CreateObject(""WScript.Shell"").Popup(""TEST"",1,""Real%20Time%20Status%20Message""))"
 
 
End Sub

sans Application.Wait Now , et ça fonctionne...