Personnaliser le texte des boutons des msgbox
#1
Débutant XLPages

Inscription: 24/09/2020
De 99 rue X

Messages: 1

Système d'exploitation:
PC
Version Excel utilisée:
2016
Posté le : 24-09 08h33

Bonjour,

Je souhaite personnaliser le texte des boutons de mes msgbox.

 

J'ai trouvé différents code sur internet mais aucun ne fonctionne:

 

 

ption Explicit
 
'===============================================================================================
' Module de code adapté des excellents travaux de Michel Pierron
' trouvé sur le site  www.excelabo.net
'
' Didier Fourgeot (myDearFriend!) -  www.mdf-xlpages.com
'===============================================================================================
'
'
' Pour obtenir une MsgBox personnalisée dans votre propre projet VBA :
' ------------------------------------------------------------------
' - Copiez (ou importez) tout d'abord le présent module de code dans votre projet VBA.
' - Puis, dans votre propre code, il suffit d'appeler la fonction MsgBox comme suit :
'
'  varReponse = MsgBoxPerso(prompt [, title] [, icon] [, caption1] [, caption2] [, cancel ])
'
'
' Comme pour une MsgBox 'classique', seul l'argument message est obligatoire :
' --------------------------------------------------------------------------
'       prompt : chaîne de caractères correspondant au texte à afficher
'       title : [facultatif] chaîne de caractères représentant le titre
'       icon : [facultatif] valeur identique que pour une MsgBox classique
'               constantes : vbCritical, vbQuestion, vbExclamation ou vbInformation
'       caption1 : [facultatif] chaîne de caractères correspondant au titre du bouton n°1
'       caption2 : [facultatif] chaîne de caractères correspondant au titre du bouton n°2
'       cancel : [facultatif] affiche un bouton Annuler dans la boîte de dialogue si = True
'
'
' Valeur de retour :
' ----------------
' Le choix de l'utilisateur est renvoyé sous forme d'une valeur (type Byte) de 0 à 2 :
'
'       0 : l'utilisateur a cliqué sur le bouton Annuler
'       1 : l'utilisateur a cliqué sur le bouton n° 1
'       2 : l'utilisateur a cliqué sur le bouton n° 2
'
'===============================================================================================
 
Private Declare PtrSafe Function SetWindowsHookEx& Lib "USER32" Alias "SetWindowsHookExA" _
        (ByVal idHook&, ByVal lpfn&, ByVal hmod&, ByVal dwThreadId&)
Private Declare PtrSafe Function GetCurrentThreadId& Lib "kernel32" ()
Private Declare PtrSafe Function CallNextHookEx& Lib "USER32" _
        (ByVal hHook&, ByVal CodeNo&, ByVal wParam&, ByVal lParam&)
Private Declare PtrSafe Function GetWindow& Lib "USER32" (ByVal hWnd&, ByVal wCmd&)
Private Declare PtrSafe Function SetWindowText& Lib "USER32" Alias "SetWindowTextA" _
        (ByVal hWnd&, ByVal lpString$)
Private Declare PtrSafe Function UnhookWindowsHookEx& Lib "USER32" (ByVal hHook&)
Private msgHook&
Private TitreBtn$(1 To 2)
 
Function MsgBoxPerso(Prompt$, Optional Title$, Optional Icon&, Optional Caption1$ = "Oui", _
    Optional Caption2$ = "Non", Optional Cancel As Boolean = False) As Byte
Dim Rep%, hInstance&
    TitreBtn(1) = Caption1
    TitreBtn(2) = Caption2
    msgHook = SetWindowsHookEx(5, AddressOf CaptionBoutons, hInstance, GetCurrentThreadId())
    Rep = MsgBox(Prompt, Icon + IIf(Cancel, vbYesNoCancel, vbYesNo), Title)
    MsgBoxPerso = Application.Max(Rep - 5, 0)
    Erase TitreBtn
End Function
 
Private Function CaptionBoutons&(ByVal nCode&, ByVal wParam&, ByVal lParam&)
Dim hWndChild&
  If nCode < 0 Then
    CaptionBoutons = CallNextHookEx(msgHook, nCode, wParam, lParam)
    Exit Function
  End If
  If nCode = 5 Then
    hWndChild = GetWindow(wParam, 5)
    Call SetWindowText(hWndChild, TitreBtn(1))
    hWndChild = GetWindow(hWndChild, 2)
    Call SetWindowText(hWndChild, TitreBtn(2))
    UnhookWindowsHookEx msgHook
  End If
  CaptionBoutons = False
End Function
Private Sub appXls_Workbookactivate(ByVal Wb As Workbook)
 
On Error GoTo ErrorHandler 'Resume Next
    If Selection.Cells.Count > 1 Then
        Exit Sub
 
 
End If
ErrorHandler:
 
Dim chemin As String, TailleDeFichier As Long
 
  chemin = Workbooks(ActiveWorkbook.Name).FullName
Debug.Print chemin
If InStr(1, chemin, "") = 0 Then
Exit Sub
End If
TailleDeFichier = FileLen(chemin)
Debug.Print TailleDeFichier
Select Case TailleDeFichier
Case Is > 20000000
 
 
Dim MonMessage As String
Dim Rep As Byte
 
    MonMessage = "CALCULS MANUELS OU AUTO"
 
    Rep = MsgBoxPerso(MonMessage, "CALCULS MANUELS OU AUTO", vbQuestion, "MANUELS", "AUTO", True)
 
    Select Case Rep
    Case 0
        Exit Sub ' ici le traitement (éventuel) si Annulation
        ' ...
    Case 1
        Application.Calculation = xlCalculationManual
Application.StatusBar = "CALCULS MANUELS" ' ici le traitement si réponse = "Super !"
        ' ...
    Case 2
        Application.Calculation = xlCalculationAutomatic
Application.StatusBar = "CALCULS AUTOMATIQUES" ' ici le traitement si réponse = "Aucun intérêt"
        ' ...
    End Select
 
 
Case Is < 20000000
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = "CALCULS AUTOMATIQUES"
End Select
 
Dim CALCULS As Boolean
CALCULS = Application.Calculation
Debug.Print CALCULS ' = xlCalculationManual
 
End Sub

Dans une macro complémentaire xlsma ou dans un modue d'un classeur xlsm:

 

sur la ligne:

 

msgHook = SetWindowsHookEx(5, AddressOf CaptionBoutons, hInstance, GetCurrentThreadId())
AddressOf CaptionBoutons

 

surligné:

 

Erreur de compilation
Utilisation incorrecte de l'opérateur AddressOf

Est-ce que quelqu'un peut m'aider?

 

MERCI BEAUCOUP

Hors Ligne
Rapport   Haut 


Vous pouvez voir les sujets.
Vous ne pouvez pas débuter de nouveaux sujets.
Vous ne pouvez pas répondre aux contributions.
Vous ne pouvez pas éditer vos contributions.
Vous ne pouvez pas effacez vos contributions.
Vous ne pouvez pas ajouter de nouveaux sondages.
Vous ne pouvez pas voter en sondage.
Vous ne pouvez pas attacher des fichiers à vos contributions.
Vous ne pouvez pas poster sans approbation.

[Recherche avancée]


Qui consulte actuellement ce sujet ?   1 Utilisateur(s) anonymes