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 |
|
|
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.
Qui consulte actuellement ce sujet ?
1 Utilisateur(s) anonymes