Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 MsgBox personnalisée

Paco974

XLDnaute Nouveau
Bonsoir à toutes et à tous !

A la recherche d'un MsgBox personnalisé, je suis tombé sur ça:

Arrivé à la ligne [With Usf], écriture du code dans l'USF, impossible de passer en mode arrêt..!

Je me suis dit que peut-être je trouverai ici une réponse, une solution à ce souci qui ne me permet pas de suivre la procédure pas à pas, pendant et après la fonction.

Je suis tout nouveau sur le site.

Par avance, je vous remercie de vos réponses.

Bien cordialement,
Paco

NB: Si vous avez d’autres propositions de MsgBox personnalisé , je suis preneur.


 
Solution
bonsoir Pierre
et comment compte tu gérer les boutons sans code
tu n'a pas le choix c'est soit un module classe soit du code dynamique
perso pour ce genre de truc avec 2/3 boutons je préfère le code dynamique

tout le code est dans la fonction
c'est pas tres compliqué a mettre en place

Dranreb

XLDnaute Barbatruc
Bonjour @BrunoM45
Oui mais là, contrairement à un MsgBox classique il faut plus d’une instruction pour le mettre en œuvre et de plus il ne fait pas le moindre effort pour adapter son aspect à la longueur du message et au nombres de boutons. Mais c’est sûr on peut aussi se contenter de ça.
 
C

Compte Supprimé 979

Guest
@Dranreb

Non, pour moi juste une instruction et on a une sub générale qui se débrouille du reste.

Pour ce qui concerne la longueur, y a-t-il un réel besoin de sortir toute l'artillerie pour ce genre de "détail" sinon on peut le faire simplement.

Bref je retourne en vacances
 

Dranreb

XLDnaute Barbatruc
Oui c'est vrai. Je voulais plutôt dire qu'il ne suffit plus d'invoquer une méthode de l'UFm, il faut en plus une procédure externe qui en corrige les éléments et l'affiche. C'est dans ce sens là qu'il y a plus de code du coté utilisateur, donc dans Module1.
 

patricktoulon

XLDnaute Barbatruc
re
bonjour la longueur du code dépend uniquement du look que l'on veut donner a mes exemples le reste tien en 3 lignes de code

une variable public(reponse) dans le userform modifié par les bouton (autant que l'on veux

récupération du .reponse dans une sub ou un événement apres la ligne show
comme les bouton hide le userform après avoir changé la variable reponse ,le userform ne bloque plus et le reste du code s’exécute
le principe même du msgbox qui lui aussi est bloquant
de toute facon on a rien sans rien
si tu veux personnaliser il te faut un peu coder
 

Dranreb

XLDnaute Barbatruc
Moi j'aime bien les méthodes et propriétés dans l'UserForm. C'est pratique parce qu'il suffit de taper son nom suivi d'un point pour que tout ce qu'on peut en utiliser soit suggéré dans un liste, et pour une méthode choisie ses arguments le sont ensuite aussi.
 

Paco974

XLDnaute Nouveau
Bonjour à tous,
Merci à vous pour vos remarques et propositions.
Effectivement cela peut ressembler à une usine à gaz, et étant débutant c'est le genre qui m'aide à comprendre et utiliser VBA Excel.
Et Je ne suis pas au bout...
Dans le cas présent ce qui est intéressant (..ce qui m’intéresse...) c'est que l'on ne se posera plus les questions de combien de boutons , où les placer, les rendre visible ou pas, etc...
Ce qui m'a intrigué, c'est le blocage du mode arrêt lorsque l'on utilise "...With Usf.CodeModule.InsertLines....", y a-il une solution, dans le cas présenté, qui permet de suivre pas à pas le code?
Pour le reste (patrickToulon)," il faut un peu coder"
Ci joint la correction suivant l'idée de Dranreb
 

Pièces jointes

  • MsgBoxPerso.xlsm
    43.8 KB · Affichages: 12

patricktoulon

XLDnaute Barbatruc
tu veux te la jouer hardcodeur
et bien ouvre un fichier vierge
met lui un module standard
dans ce module met lmui ce code ci dessous et lance la sub test
rien n'existe avant rien n'existe apres
VB:
Option Explicit
Sub test()
    MsgBox "vous avez cliqué sur " & msg("salut paco 974")
End Sub
Function msg(texte)
    Dim Obj As Object, usf
    Dim j As Integer
    Set usf = ThisWorkbook.VBProject.VBComponents.Add(3)
    With usf: .Properties("Caption") = "msgboxAA": .Properties("Width") = 250: .Properties("Height") = 150: End With

    Set Obj = usf.Designer.Controls.Add("forms.TextBox.1", "content")
    With Obj:
        .Left = 0:
        .Top = 0:
        .Width = usf.Properties("InsideWidth"):
        .Height = usf.Properties("Insideheight") - 25
        .Name = "content":
        .BackColor = &H80C0FF:
        .ForeColor = vbGreen
        .Font.Name = "algerian"
        .Font.Size = 16
        .TextAlign = 2
        .MultiLine = True
        'et toutes autre propriété des textboxs font,borderstyle,etc......
        .Value = texte


    End With
    Set Obj = usf.Designer.Controls.Add("forms.CommandButton.1", "boutonOK")
    With Obj:
        .Left = usf.Properties("Width") - 60
        .Top = usf.Properties("Height") - 25 - 20
        .Width = 50
        .Height = 20
        .Name = "bouttonOK":
        .BackColor = vbRed
        .ForeColor = vbGreen
        .Caption = "OK"
    End With

    Set Obj = usf.Designer.Controls.Add("forms.CommandButton.1", "boutoncancel")
    With Obj:
        .Left = usf.Properties("Width") - 120
        .Top = usf.Properties("Height") - 25 - 20
        .Width = 50
        .Height = 20
        .Name = "boutoncancel":
        .BackColor = vbBlue
        .ForeColor = vbMagenta
        .Caption = "ANNULER"
    End With


    'creation insertion code du des evenements
    With usf.CodeModule
        j = .CountOfLines
        .insertlines j + 1, "public reponse"
        .insertlines j + 2, "Private Sub bouttonOK_Click():reponse = ""ok"": Me.Hide:End Sub"
        .insertlines j + 3, "Private Sub boutoncancel_Click():reponse = ""Annuler"":me.hide:End Sub"
        .insertlines j + 4, "Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)"
        .insertlines j + 5, "If CloseMode = 0 Then Cancel = True:reponse=""fermer"": Me.Hide"
        .insertlines j + 6, "End Sub"


    End With
    VBA.UserForms.Add (usf.Name)
    'affichage du pseudo msgbox
    With UserForms(UserForms.Count - 1)
        .Show
        msg = .reponse
    End With
    ThisWorkbook.VBProject.VBComponents.Remove (usf)
End Function
on s'amuse comme des petits fou non ?
j'avais fait un exemple encore plus dynamique mais je le retrouve plus j'ai donc fait celui la vite fait
voila pas de userform au depart pas de module classe
rien qu'une petite fonction
rigolo non ?
rien que ce code et c'est tout
 

Paco974

XLDnaute Nouveau

J'avais bien compris qu'InsertLignes écrivait du code.!, et en ce qui concerne le blocage du mode arrêt?

Je vais tester le code que tu proposes

Merci
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil,

S'amuser ou suivre le K.I.S.S?
Cruel dilemme mais nous sommes en week-end alors amusons-nous
Retrouvé dans mes archives
VB:
Option Explicit
 
' Import
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
 
Private Declare Function SetDlgItemText Lib "user32" _
    Alias "SetDlgItemTextA" _
    (ByVal hDlg As Long, _
     ByVal nIDDlgItem As Long, _
     ByVal lpString As String) As Long
 
Private Declare Function SetWindowsHookEx Lib "user32" _
    Alias "SetWindowsHookExA" _
    (ByVal idHook As Long, _
     ByVal lpfn As Long, _
     ByVal hmod As Long, _
     ByVal dwThreadId As Long) As Long
 
Private Declare Function UnhookWindowsHookEx Lib "user32" _
    (ByVal hHook As Long) As Long
 
' Handle to the Hook procedure
Private hHook As Long
 
' Hook type
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
 
' Constants
Public Const IDOK = 1
Public Const IDCANCEL = 2
Public Const IDABORT = 3
Public Const IDRETRY = 4
Public Const IDIGNORE = 5
Public Const IDYES = 6
Public Const IDNO = 7
 
Public Sub MsgBoxSmile()
    ' Set Hook
    hHook = SetWindowsHookEx(WH_CBT, _
                             AddressOf MsgBoxHookProc, _
                             0, _
                             GetCurrentThreadId)
 
    ' Run MessageBox
    MsgBox "Smiling Message Box", vbYesNo, "Message Box Hooking"
End Sub
 
Private Function MsgBoxHookProc(ByVal lMsg As Long, _
                                ByVal wParam As Long, _
                                ByVal lParam As Long) As Long
 
    If lMsg = HCBT_ACTIVATE Then
        SetDlgItemText wParam, IDYES, ":-)"
        SetDlgItemText wParam, IDNO, ":-("
 
        ' Release the Hook
        UnhookWindowsHookEx hHook
    End If
 
    MsgBoxHookProc = False
End Function
NB: Ne pas lancer à partir de l'éditeur VBE, mais en étant dans Excel
(Donc aller dans menu Affichage puis choisir Macros)
 

Staple1600

XLDnaute Barbatruc
Re, Bonjour arthour973

arthour973
Cela ne coince pas chez moi
(Peut-être parce j'utilise un Office 32 bits sur un Windows 64bits et non pas un Office 64 bits sur un un Windows 64 bits)
Mais bon , vu l'utilité de la chose, c'est pas plus mal si cela plante chez toi

arthour (déjà en 2017... , tu avais quelques soucis)
Mais tu avais fini par faire fonctionner le truc, non?
(En tout cas, cela fonctionnait sur le PC de Si...)
 
Dernière édition:
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…