msgbox

N

nono555

XLDnaute Occasionnel
Je voudrais savoir si on peut personnaliser les boutons des msgbox : par exemple remplacer oui/non par écraser/garder.

Merci d'avance.
 
Trier par date Trier par votes
myDearFriend!

myDearFriend!

XLDnaute Barbatruc
Re : msgbox

Bonsoir nono555, Pascal76, jmps, Hervé,

Il y a quelques semaines, pour un projet perso, j'ai un peu buché sur les travaux très intéressants de Michel Pierron.

Pour illustrer ce fil, je vous livre ici un aperçu du code que je me suis permis de modifier juste un (tout petit) peu... (voir pièce jointe)

DANS UN MODULE DE CODE STANDARD
Code: 
[SIZE=2][COLOR=blue]Option Explicit[/COLOR]
[COLOR=green]'---------------------------------------------------------------------------------------[/COLOR]
[COLOR=green]' Module de code adapté des travaux de Michel Pierron
' trouvé sur le site [URL="http://www.excelabo.net"]Excelabo : Les astuces excel VBA du Disciplus.simplex[/URL]
[/COLOR] [COLOR=green]' ***************************************************[/COLOR]
[COLOR=green]' Didier FOURGEOT (myDearFriend!) - Juillet 2006[/COLOR]
[COLOR=green]' Sujet : Boutons de MsgBox personnalisés[/COLOR]
[COLOR=green]'---------------------------------------------------------------------------------------[/COLOR]
[COLOR=blue]Private Declare Function[/COLOR] SetWindowsHookEx& [COLOR=blue]Lib[/COLOR] "USER32" Alias "SetWindowsHookExA" ([COLOR=blue]ByVal[/COLOR] idHook&, [COLOR=blue]ByVal[/COLOR] lpfn&, [COLOR=blue]ByVal[/COLOR] hmod&, [COLOR=blue]ByVal[/COLOR] dwThreadId&)
[COLOR=blue]Private Declare Function[/COLOR] GetCurrentThreadId [COLOR=blue]Lib[/COLOR] "kernel32" () [COLOR=blue]As Long
Private Declare Function[/COLOR] CallNextHookEx [COLOR=blue]Lib[/COLOR] "USER32" ([COLOR=blue]ByVal[/COLOR] hHook [COLOR=blue]As Long[/COLOR], [COLOR=blue]ByVal[/COLOR] CodeNo [COLOR=blue]As Long[/COLOR], [COLOR=blue]ByVal[/COLOR] wParam [COLOR=blue]As Long[/COLOR], [COLOR=blue]ByVal[/COLOR] lParam [COLOR=blue]As Long[/COLOR]) [COLOR=blue]As Long
Private Declare Function[/COLOR] GetWindow [COLOR=blue]Lib[/COLOR] "USER32" ([COLOR=blue]ByVal[/COLOR] hWnd [COLOR=blue]As Long[/COLOR], [COLOR=blue]ByVal[/COLOR] wCmd [COLOR=blue]As Long[/COLOR]) [COLOR=blue]As Long
Private Declare Function[/COLOR] SetWindowText [COLOR=blue]Lib[/COLOR] "USER32" Alias "SetWindowTextA" ([COLOR=blue]ByVal[/COLOR] hWnd [COLOR=blue]As Long[/COLOR], [COLOR=blue]ByVal[/COLOR] lpString [COLOR=blue]As String[/COLOR]) [COLOR=blue]As Long
Private Declare Function[/COLOR] UnhookWindowsHookEx& [COLOR=blue]Lib[/COLOR] "USER32" ([COLOR=blue]ByVal[/COLOR] hHook&)
[COLOR=blue]Private[/COLOR] msgHook&
[COLOR=blue]Private[/COLOR] TitreBtn$(1 [COLOR=blue]To[/COLOR] 2)

[COLOR=blue]Function[/COLOR] MsgBoxPerso(Titr$, Msg$, Btn1$, Btn2$, BtnCancel [COLOR=blue]As Boolean[/COLOR]) [COLOR=blue]As Byte
Dim[/COLOR] Reply%, hInstance&
      TitreBtn(1) = Btn1
      TitreBtn(2) = Btn2
      msgHook = SetWindowsHookEx(5, AddressOf CaptionBoutons, hInstance, GetCurrentThreadId())
      Reply = MsgBox(Msg, IIf(BtnCancel, vbYesNoCancel, vbYesNo) + vbQuestion, Titr)
      MsgBoxPerso = Application.Max(Reply - 5, 0)
      Erase TitreBtn
[COLOR=blue]End Function[/COLOR]

[COLOR=blue]Private Function[/COLOR] CaptionBoutons&([COLOR=blue]ByVal[/COLOR] nCode&, [COLOR=blue]ByVal[/COLOR] wParam&, [COLOR=blue]ByVal[/COLOR] lParam&)
[COLOR=blue]Dim[/COLOR] hWndChild&
   [COLOR=blue]If[/COLOR] nCode < 0 [COLOR=blue]Then[/COLOR]
      CaptionBoutons = CallNextHookEx(msgHook, nCode, wParam, lParam)
      [COLOR=blue]Exit Function
   End If
   If[/COLOR] nCode = 5 [COLOR=blue]Then[/COLOR]
      hWndChild = GetWindow(wParam, 5)
      [COLOR=blue]Call[/COLOR] SetWindowText(hWndChild, TitreBtn(1))
      hWndChild = GetWindow(hWndChild, 2)
      [COLOR=blue]Call[/COLOR] SetWindowText(hWndChild, TitreBtn(2))
      UnhookWindowsHookEx msgHook
   [COLOR=blue]End If[/COLOR]
   CaptionBoutons = [COLOR=blue]False
End Function[/COLOR][/SIZE]
Pour tester ce module, 2 procédures exemples :
Code: 
[SIZE=2][COLOR=blue]Sub[/COLOR] Test1()
[COLOR=blue]Dim[/COLOR] Choix [COLOR=blue]As Byte[/COLOR]
      Choix = MsgBoxPerso("myDearFriend!", "Quel forum Excel souhaitez-vous visiter ?", "XLD", "VériTi", [COLOR=blue]True[/COLOR])
      [COLOR=blue]Select Case[/COLOR] Choix
      [COLOR=blue]Case[/COLOR] 1
            ThisWorkbook.FollowHyperlink "http://www.excel-downloads.com/forum/forum-excel/"
      [COLOR=blue]Case[/COLOR] 2
            ThisWorkbook.FollowHyperlink "http://www.veriti.net/forum/viewforum.php?f=1"
      [COLOR=blue]End Select
End Sub[/COLOR]

[COLOR=blue]Sub[/COLOR] Test2()
[COLOR=blue]Dim[/COLOR] Choix [COLOR=blue]As Byte[/COLOR]
      Choix = MsgBoxPerso("myDearFriend!", "Comment trouvez-vous les forums XLD et VériTi ?", "Super !", "Génial !!!", [COLOR=blue]False[/COLOR])
      MsgBox "Vous avez choisi : " & Choose(Choix, "Super", "Génial"), vbOKOnly, "myDearFriend!"
[COLOR=blue]End Sub[/COLOR][/SIZE]
Chose curieuse : lancés directement depuis l'éditeur VBE, ces tests ne fonctionnent pas (les boutons gardent leur valeur Oui/Non). Lancés depuis l'interface Excel, ça fonctionne !

Cordialement,
 

Pièces jointes

  • mDF_btnMsgBoxPerso.zip
    15 KB · Affichages: 286
Vote positif 0 Vote négatif
Hervé

Hervé

XLDnaute Barbatruc
Re : msgbox

bonjour tout le monde

superbe travail didier, merci :)

petite question, peut-on imaginer pouvoir mettre plus de 3 boutons dans le msgbox ?

faudra-t'il utiliser un paramarray dans la function MsgBoxPerso ?

si oui comment faire ?

hein, pardon ? , je fais ch..r avec mes questions ?

ah ok, je sors.

salut
 
Vote positif 0 Vote négatif
myDearFriend!

myDearFriend!

XLDnaute Barbatruc
Re : msgbox

Bonsoir nono555, Pascal76, jmps, Hervé, nat54, le Forum,

Tout d'abord, merci Michel et Hervé, mais comme je le dis plus haut, le boulot, c'est surtout Michel Pierron qui l'a fait :)!

Hervé à dit:
petite question, peut-on imaginer pouvoir mettre plus de 3 boutons dans le msgbox ?
Cliquez pour agrandir...
On peut tout imaginer je pense (ou presque)...;), cela dit, avec le code à base d'API issu de Michel Pierron ça me paraît guère probable... Ce code utilise comme base, une "vraie" MsgBox avec bouton "Yes/No/Cancel". Les fonctions API utilisées là, permettent uniquement de renommer ces boutons à l'affichage , mais ne permettent pas, comme ça, d'ajouter des boutons à ta guise... En tout cas, c'est hors de mes compétences l:eek:...

Hervé à dit:
faudra-t'il utiliser un paramarray dans la function MsgBoxPerso
Cliquez pour agrandir...
Eh bien justement, comme j'ai trouvé le sujet sympa, je me suis amusé à bricoler une nouvelle façon de faire, sans API cette fois, et en utilisant effectivement un argument ParamArray...

Construire un Userform pour simuler une MsgBox est effectivement une bonne solution pour qui veut personnaliser ses boutons et en avoir autant que souhaité. On peut en tirer d'autres avantages aussi : modifier la police, la taille des caractères, l'alignement etc...

De mon point de vue, on se confronte toutefois à un inconvénient majeur : le poids représenté par l'Userform en question... Par ailleurs, adapter cet Userform pour qu'il puisse gérer plusieurs messages dans la même appli peut être parfois un véritable casse-tête : adapter l'userform à la taille du texte, afficher 1 ou plusieurs boutons pour tel ou tel messages à diffuser, etc...

Dans l'exemple ci-joint, j'ai donc opté pour un Userform créé à la volée avec une durée de vie aussi éphémère qu'une vraie MsgBox ! De cette manière, j'économise le poids d'un Usf "en dur" dans le fichier une fois enregistré sur le disque, et la gestion du nombre de boutons, leur disposition devient beaucoup plus aisée...

Dans cet exemple :
  • La taille du Userform s'adapte au texte et aux boutons.
  • La taille et l'alignement des boutons est automatique.
  • On peut mettre autant de boutons que souhaité.
  • La police de caractères, la taille et l'alignement du texte sont définissables lors de l'appel de la fonction (voir le code de l'exemple Test1)
On peut bien évidemment ajouter d'autres possibilités et je compte bien essayer d'améliorer encore ce code lorsque j'aurai un peu plus de temps...

DANS UN MODULE DE CODE STANDARD
Code: 
[SIZE=2][COLOR=blue]Option Explicit[/COLOR]
[COLOR=green]'---------------------------------------------------------------------------------------[/COLOR]
[COLOR=green]' Auteur      : Didier FOURGEOT (myDearFriend!) - www.mdf-xlpages.com[/COLOR]
[COLOR=green]' Date         : 13/09/2006[/COLOR]
[COLOR=green]' Sujet        : MsgBoxPerso et boutons personnalisés[/COLOR]
[COLOR=green]'---------------------------------------------------------------------------------------[/COLOR]
[COLOR=blue]Public[/COLOR] VmsgBox [COLOR=blue]As Byte[/COLOR]

[COLOR=blue]Function[/COLOR] mDFmsgBox(Titre$, Message$, Align [COLOR=blue]As Byte[/COLOR], Police$, TailleCaract [COLOR=blue]As Byte[/COLOR], ParamArray B()) [COLOR=blue]As Byte
Dim[/COLOR] USF [COLOR=blue]As Object
Dim[/COLOR] btnB [COLOR=blue]As[/COLOR] MSForms.CommandButton
[COLOR=blue]Dim[/COLOR] lblM [COLOR=blue]As[/COLOR] MSForms.Label
[COLOR=blue][COLOR=blue]Dim[/COLOR] [COLOR=Black]LngMaxB [/COLOR][COLOR=blue]As Integer[/COLOR], [COLOR=Black]Marge [/COLOR][COLOR=blue]As Integer[/COLOR], [COLOR=Black]NbC [/COLOR][COLOR=blue]As Integer[/COLOR][/COLOR]
[COLOR=blue]Dim[/COLOR] i [COLOR=blue]As Byte[/COLOR]
      [COLOR=green]'Création du USF[/COLOR]
      [COLOR=blue]Set[/COLOR] USF = ThisWorkbook.VBProject.VBComponents.Add(3)
      [COLOR=green]'Titre[/COLOR]
      USF.Properties("Caption") = Titre
      [COLOR=green]'Zone de message[/COLOR]
      [COLOR=blue]Set[/COLOR] lblM = USF.Designer.Controls.Add("Forms.Label.1")
      [COLOR=blue]With[/COLOR] lblM
            .Move 0, 15, 1000, 1000
            .WordWrap = [COLOR=blue]False[/COLOR]
            .Font.Size = TailleCaract
            .Font.Name = Police
            .Caption = Message
            .AutoSize = [COLOR=blue]True
      End With[/COLOR]
      [COLOR=green]'Boutons[/COLOR]
      [COLOR=blue]For[/COLOR] i = 0 [COLOR=blue]To UBound[/COLOR](B)
            [COLOR=blue]Set[/COLOR] btnB = USF.Designer.Controls.Add("Forms.CommandButton.1")
            [COLOR=blue]With[/COLOR] btnB
                  .AutoSize = [COLOR=blue]True[/COLOR]
                  .Caption = B(i)
                  LngMaxB = Application.Max(LngMaxB, .Width)
                  .AutoSize = [COLOR=blue]False
            End With
      Next[/COLOR] i
      [COLOR=green]'Mise en place des contrôles dans le USF[/COLOR]
      [COLOR=blue]With[/COLOR] lblM
            USF.Properties("Width") = Application.Max((LngMaxB + 10) * ([COLOR=blue]UBound[/COLOR](B) + 1) + 5, _
                        .Width + 20)
            USF.Properties("Height") = 85 + .Height
            .AutoSize = [COLOR=blue]False[/COLOR]
            .Move 10, 15, USF.Properties("Width") - 20, .Height
            .TextAlign = Align
      [COLOR=blue]End With[/COLOR]
      Marge = (USF.Properties("Width") - (LngMaxB + 5) * ([COLOR=blue]UBound[/COLOR](B) + 1)) / 2
      [COLOR=blue]For[/COLOR] i = 0 [COLOR=blue]To UBound[/COLOR](B)
            [COLOR=blue]With[/COLOR] USF
                  .Designer.Controls("CommandButton" & i + 1).Move Marge + (LngMaxB + 5) * i, _
                              lblM.Top + lblM.Height + 15, LngMaxB, 20
                  [COLOR=green]'Procédures évènementielles liées aux boutons[/COLOR]
                  [COLOR=blue]With[/COLOR] .CodeModule
                        .InsertLines .CountOfLines + 1, "Sub CommandButton" & i + 1 & "_Click():VmsgBox =" _
                                    & i + 1 & " :Unload Me:[COLOR=blue]End[/COLOR] Sub"
                  [COLOR=blue]End With
            End With
      Next[/COLOR] i
      [COLOR=green]'Empêche fermeture par la croix[/COLOR]
      [COLOR=blue]With[/COLOR] USF.CodeModule
            .InsertLines .CountOfLines + 1, "Private [COLOR=blue]Sub[/COLOR] UserForm_QueryClose(Cancel [COLOR=blue]As Integer[/COLOR]," _
                        & " CloseMode [COLOR=blue]As Integer[/COLOR]):Cancel = CloseMode = 0:[COLOR=blue]End[/COLOR] Sub"
      [COLOR=blue]End With[/COLOR]
      [COLOR=green]'Affiche, puis détruit le USF[/COLOR]
      VBA.UserForms.Add(USF.Name).Show
      ThisWorkbook.VBProject.VBComponents.Remove USF
      mDFmsgBox = VmsgBox
[COLOR=blue]End Function[/COLOR][/SIZE]

Et comme pour l'exemple précédent, 2 procédures pour tester :
Code: 
[SIZE=2][COLOR=blue]Sub[/COLOR] Test1()
[COLOR=blue]Dim[/COLOR] Titre [COLOR=blue]As String[/COLOR], Message [COLOR=blue]As String[/COLOR], Police [COLOR=blue]As String
Dim[/COLOR] Alignement [COLOR=blue]As Byte[/COLOR], Taille [COLOR=blue]As Byte
Dim[/COLOR] Choix [COLOR=blue]As Byte[/COLOR]
      Titre = "MsgBoxPerso par myDearFriend!"
      Message = "Quel lien Excel souhaiteriez-vous visiter ?" & vbLf & "Faites votre choix :"
      Alignement = 2         [COLOR=green]'1=Droite / 2=Centre / 3=Gauche[/COLOR]
      Police = "Tahoma"
      Taille = 10              [COLOR=green]'Taille des caractères[/COLOR]
      
      Choix = mDFmsgBox(Titre, Message, Alignement, Police, 10, "XLD", "VériTi", "Le WikiXLD", "mDF-XLpages", "Annuler")
      [COLOR=blue]Select Case[/COLOR] Choix
      [COLOR=blue]Case[/COLOR] 1
               ThisWorkbook.FollowHyperlink "http://www.excel-downloads.com/"
      [COLOR=blue]Case[/COLOR] 2
               ThisWorkbook.FollowHyperlink "http://www.veriti.net/"
      [COLOR=blue]Case[/COLOR] 3
               ThisWorkbook.FollowHyperlink "http://www.excel-downloads.com/html/French/phpwiki/"
      [COLOR=blue]Case[/COLOR] 4
               ThisWorkbook.FollowHyperlink "http://www.mdf-xlpages.com/"
      [COLOR=blue]End Select
End Sub[/COLOR]

[COLOR=blue]Sub[/COLOR] Test2()
[COLOR=blue]Dim[/COLOR] Titre [COLOR=blue]As String[/COLOR], Message [COLOR=blue]As String
Dim[/COLOR] Choix [COLOR=blue]As Byte[/COLOR]
      Titre = "MsgBoxPerso par myDearFriend!"
      Message = "Comment trouvez-vous les liens Excel proposés en Test1 ?"
      Choix = mDFmsgBox(Titre, Message, 2, "Comic Sans MS", 14, "Bof", "Mouais...", "Génial")
      MsgBox "Vous avez choisi : " & Choose(Choix, "Bof", "Mouais...", "Génial"), vbOKOnly, "myDearFriend!"
[COLOR=blue]End Sub[/COLOR][/SIZE]
ATTENTION toutefois, pour que ça puisse fonctionner, il convient impérativement de veiller à ce que l'option "Faire confiance au projet Visual Basic" soit cochée dans le menu Outils / Macros / Sécurité.

Cordialement,
 

Pièces jointes

  • mDF_USFMsgBoxPerso.zip
    20.2 KB · Affichages: 202
  • mDF_USFMsgBoxPerso.zip
    20.2 KB · Affichages: 224
  • mDF_USFMsgBoxPerso.zip
    20.2 KB · Affichages: 217
Dernière édition:
Vote positif 0 Vote négatif
Hervé

Hervé

XLDnaute Barbatruc
Re : msgbox

bonjour tout le monde

tout simplement genial

ma question n'etait pas du tout innocente car l'idée du usf crée à la volée me trottait dans la tete depuis un moment.

j'avais été arrété par 2 choses : la mise en place des boutons (je me paumais dans les width et autres height) et le renvoi du choix.

d'un coup tout devient clair quand je vois ton code :

Sub CommandButton1_Click(): VmsgBox = 1: Unload Me: End Sub

et ca : mDFmsgBox = VmsgBox

je te remercie pour le temps que tu a consacré à ce travail, qui va combler plus d'une personne.

salut

ps : tiens, un nouveau site parlant d'excel ? :rolleyes:
 
Vote positif 0 Vote négatif
PascalXLD

PascalXLD

XLDnaute Barbatruc
Modérateur
Re : msgbox

RE

Bon je n'ai pas trop le temps en ce moment de me pencher sur ton codeDidier mais je suis sûr que cela est génial

Alors je n'ai pas peur de te remercier d'avance.

Bonne journée

Ps : Hervé je n'ai pas compris "tiens, un nouveau site parlant d'excel ? :rolleyes:"
 
Vote positif 0 Vote négatif
J

jipeh

XLDnaute Nouveau
Re : msgbox

Sympa ce code ! Je l'ai repris pour un de mes travaux en l'utilisant de la façon suivante :
Code: 
Private Sub Workbook_Opentest()
Dim Titre As String, Message As String, Police As String
Dim Alignement As Byte, Taille As Byte
Dim Choix As Byte
Dim z As String
      Titre = "Mapping choice"
      Alignement = 2         '1=Droite / 2=Centre / 3=Gauche
      Police = "Arial"
      Message = "Which kind of map do you want to use ?"
      Choix = mDFmsbox(Titre, Message, Alignement, Police, 10, 1,2,3,4)

        
            Select Case Choix
      Case 1 = 
       Case 2 = 
      Case 3 = 
      Case 4 =     
  End Select

End Sub

En fait mon soucis est que quelque soit le bouton sur lequel je clique le choix va être 0. On ne peux donc pas avoir de différenciation de résultat... Si vous avez une idée :)
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

H
  • Question
Microsoft 365 Format de cellule
Réponses
3
Affichages
170
Simply
Simply
Z
  • Résolu(e)
Microsoft 365 Problème de combinaison entre fonctions "If Then Else" et "SelectCase"
Réponses
11
Affichages
253
Zonmé
Z
P
  • Question
Microsoft 365 Désactivation/activation Application.CommandBars("ply").Enabled
Réponses
6
Affichages
252
pat66
P
B
  • Résolu(e)
XL 2016 Concours/ Adapter ou modifier le fonctionnement de deux boutons dans un use forme
Réponses
10
Affichages
237
Oneida
Oneida
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Deux modules dans un seul module (syntaxe)
Réponses
2
Affichages
145
chaelie2015
chaelie2015
L
  • Question
XL 2016 Ajout (et tri dans la liste) d'un fournisseur à une table par UserForm
Réponses
3
Affichages
250
Lorenzini
L
N
  • Question
XL 2019 Inserer une ligne
Réponses
7
Affichages
225
netparty
N
B
  • Résolu(e)
XL 2016 Ajouter un bouton dans un use forme
Réponses
9
Affichages
99
patricktoulon
patricktoulon
Nico2978
  • Résolu(e)
XL 2019 Aide pour un module d'archivage de feuille en pdf dans répertoire
Réponses
5
Affichages
199
Nico2978
Nico2978
M
  • Question
XL 2021 Mise en Forme Conditionnelle avec Formule Complexe
Réponses
4
Affichages
224
sylvanu
sylvanu

Membres actuellement en ligne

2 membres et 49 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 321
Messages
2 087 266
Membres
103 501
dernier inscrit
talebafia