MsgBox personnalisé en VBA

**Robert1957** · 23/10/2014, 14h11

Bonjour,

Après plusieurs recherche je ne trouve pas de solution à mon problème. Est-il possible de modifier le dernier bouton d'un MsgBox? Que je choisisse n'importe quel type de MsgBox le dernier bouton n'est jamais modifiable (accessible), du moins je n'ai pas trouvé comment...

Nom : MsgBox.PNG
Affichages : 7823
Taille : 25,7 Ko

Nom : MsgBox.PNG
Affichages : 7823
Taille : 25,7 Ko

Voici le code (adapté d'un forum Excel: excelabo)

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
Public Function fuMsgBox_ChangeBtnText()
  Const WH_CBT = 5
  Const Title As String = "Vérification de l'enveloppe"
  Const msg As String = "Est-ce que l'enveloppe est présente?" & vbCrLf & "Si la réponse est non, ignorer!"
  Dim Reply As Integer
 
  BtnTitle(1) = "Commune": BtnTitle(2) = "Oui": BtnTitle(3) = "Non"
  'set up the hook
  msgHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxTitleBtnProc, hInstance, GetCurrentThreadId())
  'call  function
  Reply = MsgBox(msg, vbAbortRetryIgnore + vbQuestion, Title)
  If Reply = vbAbort Then
    fuMsgBox_ChangeBtnText = "Commune"
  ElseIf Reply = vbRetry Then
    fuMsgBox_ChangeBtnText = "Oui"
  Else
    fuMsgBox_ChangeBtnText = "Non"
  End If
  Erase BtnTitle
End Function
 
Private Function MsgBoxTitleBtnProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  Const HCBT_ACTIVATE = 5
  Const GW_CHILD = 5
  Const GW_HWNDNEXT = 2
  If nCode < 0 Then
    MsgBoxTitleBtnProc = CallNextHookEx(msgHook, nCode, wParam, lParam)
    Exit Function
  End If
  If nCode = HCBT_ACTIVATE Then
    Dim hWndChild As Long, hWndChildD As Long
    'premier bouton: Abort button
    hWndChildD = GetWindow(wParam, GW_CHILD)
    'changer pour Commune
    Call SetWindowText(hWndChildD, BtnTitle(1))
    'deuxième bouton: Retry button
    hWndChild = GetWindow(hWndChildD, GW_HWNDNEXT)
    'changer pour Oui
    Call SetWindowText(hWndChild, BtnTitle(2))
    'Ici je voudrais changer le troisième bouton
    'Je ne trouve pas l'adresse, semble ne pas exister
    '.....................................
    'Release the hook
    UnhookWindowsHookEx msgHook
  End If
  ' processing...
  MsgBoxTitleBtnProc = False
End Function

Merci à l'avance

Robert

**LedZeppII** · 24/10/2014, 18h54

Bonjour,

J'ai essayé comme ceci:

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
  If ncode = HCBT_ACTIVATE Then
    Dim hWndChild As Long, hWndChilNext As Long
    'premier bouton: Abort button
    hWndChild = GetWindow(wParam, GW_CHILD)
    'changer pour Commune
    Call SetWindowText(hWndChild, BtnTitle(1))
 
    'deuxième bouton: Retry button
    hWndChilNext = GetWindow(hWndChild, GW_HWNDNEXT)
    hWndChild = hWndChilNext
    'changer pour Oui
    Call SetWindowText(hWndChild, BtnTitle(2))
 
    'Ici je voudrais changer le troisième bouton
    'Je ne trouve pas l'adresse, semble ne pas exister
    '.....................................
    hWndChilNext = GetWindow(hWndChild, GW_HWNDNEXT)
    hWndChild = hWndChilNext
    'changer pour Oui
    Call SetWindowText(hWndChild, BtnTitle(3))
 
  End If

Pour moi ça fonctionne (je suis en Access 2007).

Remarque: j'ai du déplacer UnhookWindowsHookEx msgHook dans la fonction fuMsgBox_ChangeBtnText(), après le MsgBox, pour que ça fonctionne.
Là où il était placé, ça ne fonctionnait pour aucun des trois boutons chez moi.

A+

**Robert1957** · 24/10/2014, 19h45

Bonjour LedZeppII,

C'est exactement ça.

Chez moi la fonction est ok avec 2010 sauf qu'il ne faut pas être en mode debug.

Mille fois merci!!!

**Jeannot45** · 31/10/2014, 08h43

J'ai lu avec beaucoup d’intérêt ton problème concernant la personnalisation de la MsgBox

Je me permets de te contacter par MP car le sujet étant clos, je ne savais pas si je pouvais le rouvrir afin de compléter le sujet pour les autres membres.
Si tu le souhaites, je peux rouvrir le fil et continuer le sujet.

Voici donc ma problématique :
J'ai récupéré ton code. Deux soucis émergent :

Comment appeler ces fonctions dans une procédures pour personnaliser mon MsgBox
Récupère-t-on automatiquement les MsgBox stantdard en suite ?

Merci beaucoup pour ta contribution
Merci

**Robert1957** · 31/10/2014, 13h58

Bonjour Jean,

Pour la deuxième question, oui on récupère les messages standards pas la suite.

Voici le code complet avec différents tests. J'ai modifié la fonction tel que discuté en MP pour que celle-ci prenne certains arguments.

Premièrement un module standard que j'ai nommé Mod_Env:

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
78
79
80
81
82
83
84
Option Compare Database
Option Explicit
 
'Fonctions windows
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function SetWindowsHookEx& Lib "USER32" Alias "SetWindowsHookExA" (ByVal idHook&, ByVal lpfn&, ByVal hmod&, ByVal dwThreadId&)
Private Declare Function UnhookWindowsHookEx& Lib "USER32" (ByVal hHook&)
Private Declare Function CallNextHookEx Lib "USER32" (ByVal hHook As Long, ByVal CodeNo As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindow Lib "USER32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function SetWindowText Lib "USER32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long
 
'Variables
Private Type CWPSTRUCT
  lParam As Long
  wParam As Long
  Message As Long
  hWnd As Long
End Type
 
Private msgHook&, hInstance&
Private TitleMsgBox As String, strMsg As String, BtnTitle(3) As String
 
Public Function fuMsgBox_ChangeBtnText(sTitle As String, sMsg As String, sB1 As String, sB2 As String, sB3 As String)
'Pour personnalisé le titre, le message et les boutons
'Ici 3 boutons obligatoires.  On pourrait aller plus loin en faisant un select case pour le nombre de bouton,
'Il faudrait alors ajuster le choix du type de message de base. Ici j'ai choisi vbAbortRetryIgnore parce que le but
'était d'avoir 3 boutons.
  Const WH_CBT = 5
  Dim Reply As Integer
  'Ici on inscrit les nouveaux titres sur les boutons
  BtnTitle(1) = sB1: BtnTitle(2) = sB2: BtnTitle(3) = sB3
  'set up the hook
  msgHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxTitleBtnProc, hInstance, GetCurrentThreadId())
  'call  function
  Reply = MsgBox(sMsg, vbAbortRetryIgnore + vbQuestion, sTitle)
  'free the hook
  UnhookWindowsHookEx msgHook
  'Selon le bouton choisi si on veut autre chose que les constantes Windows
  'On pourrait passer la réponse dans la fonction pour avoir autre chose que le titre des boutons.
  Select Case Reply
    Case vbAbort
       fuMsgBox_ChangeBtnText = sB1
    Case vbRetry
        fuMsgBox_ChangeBtnText = sB2
    Case vbIgnore
        fuMsgBox_ChangeBtnText = sB3
  End Select
  Erase BtnTitle
  'Test pour voir que les msgbox sont de retour
  MsgBox "Est-ce que les boutons sont de retour!!!", vbAbortRetryIgnore
 
End Function
 
Private Function MsgBoxTitleBtnProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
  Const HCBT_ACTIVATE = 5
  Const GW_CHILD = 5
  Const GW_HWNDNEXT = 2
  If nCode < 0 Then
    MsgBoxTitleBtnProc = CallNextHookEx(msgHook, nCode, wParam, lParam)
    Exit Function
  End If
    If nCode = HCBT_ACTIVATE Then
    Dim hWndChild As Long, hWndChildNext As Long
    'premier bouton: Abort button
    hWndChild = GetWindow(wParam, GW_CHILD)
    'changer pour sB1
    Call SetWindowText(hWndChild, BtnTitle(1))
    'deuxième bouton: Retry button
    hWndChildNext = GetWindow(hWndChild, GW_HWNDNEXT)
    hWndChild = hWndChildNext
    'changer pour sB2
    Call SetWindowText(hWndChild, BtnTitle(2))
    'Troisième bouton: Ignore
    hWndChildNext = GetWindow(hWndChild, GW_HWNDNEXT)
    hWndChild = hWndChildNext
    'changer pour sB3
    Call SetWindowText(hWndChild, BtnTitle(3))
 
  End If
  ' processing...
  MsgBoxTitleBtnProc = False
 
End Function

Puis on appelle cette fonction comme suit:

Code :

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

1
2
3
4
5
6
7
8
Private Sub btnMessage_Click()
 
    Dim strReponse As String
 
    strReponse = fuMsgBox_ChangeBtnText("Ici le titre", "Ici le message", "Bouton # 1", "Bouton # 2", "Bouton # 3")
    MsgBox "Vous avez choisi :  " & strReponse
 
End Sub

Les tests ont été faits avec Access 2010.

En complément, le changement du titre des boutons ne fonctionne pas en mode pas à pas.

Bonne journée

**Jeannot45** · 01/11/2014, 08h23

La réponse est complète et ça fonctionne à merveille

Merci pour cette très intéressante contribution

**article50** · 09/06/2016, 02h57

grâce à ce sujet, j'utilise des msgbox avec 3 boutons : "ouvrir", "recopier" et "supprimer"
ça fonctionne très bien !
petite question : la croix dans le coin nord/est ne fonctionne pas, ni la touche "escape". Aurai-je un moyen de sortir de ma msgbox?

**argyronet** · 10/06/2016, 15h32

Bonjour,

L'effet de la touche Esc n'est possibe qu'à partir du moment où tu as un Cancel donc soit un vbOkCancel ou un vbYesNoCancel ou encore un vbRetryCancel.

Argy

**article50** · 15/06/2016, 23h03

merci pour l'info!

MsgBox personnalisé en VBA [AC-2010]

Access

Discussions similaires

Partager

Partager