XL 2016 MsgBox personnalisée

[Paco974]

Bonsoir à toutes et à tous !

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

mDF MsgBoxPerso « le Retour » - Tutoriels & Astuces Excel > L'API Windows - Tutoriels : myDearFriend! Excel Pages

Une «vraie fausse» MsgBox avec boutons personnalisés et bien plus encore... Voici donc le 3ème et dernier volet des articles que je consacre à la MsgBox, outil bien connu des développeurs VBA puisqu' il s' agit du premier moyen à disposition pour interagir avec l' utilisateur. Dans un premier...

www.mdf-xlpages.com

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.

 

[Dranreb]

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.

 

[Compte Supprimé 979]

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

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]

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]

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]

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

 

[patricktoulon]

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

c'est pour ajouter ou supprimer du code dans le module du userfom

 

[patricktoulon]

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

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]

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

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

 

[Paco974]

Je vais garder ce code, merci.
Note que le pas à pas ou Stop n'est pas admis lorsque l'on utilise [InsertLignes] .
Mais finalement ce n'est vraiment pas un souci.

Merci à tous

 

[Staple1600]

Bonjour le fil,

S'amuser ou suivre le K.I.S.S?
Cruel dilemme mais nous sommes en week-end alors amusons-nous

Spoiler: L'API dans le futile

Retrouvé dans mes archives

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)

 

[Usine à gaz]

Hello JM, le Forum,

ça coince là :

Bon WE à toutes et à tous,
lionel

 

[Staple1600]

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

XL 2013 - msgbox affichage oui et non

Bonjour à toutes et à tous, J'ai bcp hésité avant de poster LOL. Ma question pourra sembler un peu folle :confused:. C'est pour la présentation et pour le fun. Ma question : Les msgbox s'affichent avec le OUI et NON en dessous des textes ou propositions. Et, folle envie de ma part :p...

www.excel-downloads.com

 

[Usine à gaz]

Re JM,
Merci pour le rafraîchissement du fil de 2013

- j'utilise également un Office 32 bits sur un Windows 64bits
Office 2016 et windows10

Bizarre, vous avez dit ...

 

[Staple1600]

Re

En tout cas, dans les deux cas, le code fonctionne.
(On est au moins deux à le dire Si... et moi