Personnaliser le texte des boutons des msgbox | ||
---|---|---|
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 |
|
|
Forums - Tous les messages