Forums XLPages

Tous les messages (PaoK)

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