Discussion :

[Oliv-]

Bonjour,

Voici 2 méthodes pour obtenir des MSGBOX non bloquants en VBA (alerte uniquement)

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
Sub Msgbox_dynvbs(Message, Titre)
Dim wscript
'écriture du vbs
Open Environ("temp") & "\myvbs.vbs" For Output As #1
Print #1, "Msgbox " & Chr(34) & Message & Chr(34) & ", ," & Chr(34) & Titre & Chr(34)
Close #1
DoEvents
 
Set wscript = CreateObject("wscript.shell")
wscript.Run "wscript.exe " & Environ("temp") & "\myvbs.vbs"
Sleep 1000
'suppression du vbs
Kill Environ("temp") & "\myvbs.vbs"
 
End Sub
 
Sub Test_Msgbox_dynvbs()
Message = "test non modal"
Titre = "Msgbox non bloquant"
Call Msgbox_dynvbs(Message, Titre)
End Sub

ou

Code :

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

1
2
3
4
Sub MSGBOX_MSG()
Message = "test non modal"
Shell "MSG " & Environ("username") & " " & Message
End Sub

[Marc-L]

Bonjour,

ou utiliser directement un UserForm non modal …

[Oliv-]

Bonjour,
Ok pour l'userform mais alors créé
Dynamiquement

[Oliv-]

Bonjour,
Voici donc une autre solution avec la création et destruction dynamique d'un USERFORM.
Le code est adapté d'une exemple de silkyroad.

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
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
Public Usf As Object
Public UsfName1 As String
 
Sub CreationUSF()
    Dim X As Object
    Dim i As Integer
    Dim Titre As String, Message As String
    Message = "test non modal"
    Titre = "Msgbox non bloquant"
 
    Set X = creationUserForm_Et_Label_Dynamique(Titre, Message)
    UsfName = X.Name
    DoEvents
    Application.OnTime Now + TimeValue("00:00:00"), "'lancementUSF " & UsfName & "'"
End Sub
 
Sub lancementUSF(UsfName)
    UsfName1 = UsfName.Name
    UsfName.Show vbModeless
End Sub
 
Sub killUSf()
    ThisWorkbook.VBProject.VBComponents.Remove Application.VBE.ActiveVBProject.VBComponents(UsfName1)
End Sub
 
Function creationUserForm_Et_Label_Dynamique(Titre As String, Message As String) As Object
    Dim ObjTextBox As Object
    Dim ObjBtn As Object
    Dim j As Integer
 
    Set Usf = ThisWorkbook.VBProject.VBComponents.Add(3)
    With Usf
        .Properties("Caption") = Titre
        .Properties("Width") = 300
        .Properties("Height") = 200
    End With
 
    Set ObjTextBox = Usf.Designer.Controls.Add("Forms.label.1")
 
    With ObjTextBox
        .Left = 20: .Top = 10: .Width = 90: .Height = 20
        .Caption = Message
    End With
 
    Set ObjBtn = Usf.Designer.Controls.Add("Forms.Commandbutton.1")
 
    With ObjBtn
        .Left = 120: .Top = 100: .Width = 60: .Height = 20
        .Name = "ok"
        .Caption = "OK"
    End With
 
    With Usf.CodeModule
        j = .CountOfLines
        .InsertLines j + 1, "Sub " & "ok" & "_Click()"
        .InsertLines j + 2, "Application.OnTime Now + TimeValue(""00:00:00""), ""killUSF """
        .InsertLines j + 4, "unload me"
        .InsertLines j + 5, "End Sub"
 
        'fermeture automatique après 10 secondes
        .InsertLines j + 6, " "
        .InsertLines j + 7, "Private Sub UserForm_Activate()"
        .InsertLines j + 9, "Application.OnTime Now + TimeValue(""00:00:10""), ""killUSF """
        .InsertLines j + 11, "End Sub"
    End With
 
    VBA.UserForms.Add (Usf.Name)
    Set creationUserForm_Et_Label_Dynamique = UserForms(UserForms.Count - 1)
End Function

[Oliv-]

En complèment ( adapté d'un code publié par bucgif):

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
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

[Oliv-]

Code :

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

1
2
3
4
Sub test_popup()
 
CreateObject("WScript.Shell").Run "mshta.exe vbscript:close(CreateObject(""WScript.Shell"").Popup(""Ceci est un message temporaire"",2,""Real%20Time%20Status%20Message""))"
End Sub

[patricktoulon]

re
bonjour

et pour un msgbox temporaire en vbs et autodestructible(le fichier vbs s'autodétruit) et non bloquant
bien sur c'est pour ceux qui n'ont pas hiniber wscript.exe de leur system

Code :

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

1
2
3
4
5
6
7
8
Function msgboxtempo(titre, texte, temps)
    codevbs = "CreateObject(""Wscript.shell"").Popup" & Chr(34) & texte & Chr(34) & "," & temps & "," & Chr(34) & titre & Chr(34) & vbCrLf
    codevbs = codevbs & "Set fso = wscript.CreateObject(""Scripting.FileSystemObject"")" & vbCrLf
    codevbs = codevbs & "fso.deletefile WScript.ScriptFullName"
    chemin = Environ("userprofile") & "\Desktop\msgbox.vbs"
    Open chemin For Output As #1: Print #1, codevbs: Close #1
    CreateObject("wscript.shell").Run "wscript.exe " & chemin
End Function

sub de teste

Code :

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

1
2
3
Sub testmsgboxtempo()
    msgboxtempo "test de msgbox", "essaie de message temporaire", 2
End Sub

[Oliv-]

Bonjour,
une petite mise à jour pour WINDOWS 7 64 bits avec Office 32 bits
Msg ne peut pas être appelé depuis c:\windows\system32\ mais depuis c:\windows\sysnative\

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
Private Sub test_MSGBOX_MSG()
    message = "Hello world"
    MSGBOX_MSG (message)
End Sub
 
Sub MSGBOX_MSG(message)
    Dim wsh As Object
    Dim lngErr As Long
    On Error Resume Next
    Err.Clear
 
    str_to_pass = "c:\windows\sysnative\msg " & Environ("username") & " " & message
    Call Shell("cmd.exe /s /c " & str_to_pass, vbMinimizedNoFocus)
    If Err Then
        Set wsh = VBA.CreateObject("WScript.Shell")
        CreateObject("WScript.Shell").Run "mshta.exe vbscript:close(CreateObject(""WScript.Shell"").Popup(""" & message & """,0,""Test%20Oliv""))"
 
' vous pouvez remplacer 0 par 5 par exemple (ou autre valeur) si vous ne souhaitez que le message se ferme automatiquement après 5 secondes
 
    End If
End Sub