XL 2013 msgbox affichage oui et non

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
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, j'aimerais que ça s'affiche différemment.
Mes recherches non pas abouti car ce n'est peut-être pas possible mais ..... les magiciens peuvent beaucoup LOL.

Le fichier joint exprimera mieux mon souhait.

Avec mes remerciements,
Bonne journée à toutes et à tous.
Amicalement,
Lionel,
 

Pièces jointes

  • Test présentation msgbox.xlsm
    51.7 KB · Affichages: 42

Jauster

XLDnaute Occasionnel
Hello Arthour973

Oui je viens d'ouvrir le fichier, et j'ai répondu dans la précipitation sans vraiment prendre le temps de comprendre ta demande ^^ Désolé

Je pense qu'il en est de même avec la disposition du texte, puisque les msgbox sont gérées par Windows OS.
Mais ça reste à confirmer
 

Modeste geedee

XLDnaute Barbatruc
nsour®
Bonjour à toutes et à tous,
C'est pour la présentation et pour le fun.
Les msgbox s'affichent avec le OUI et NON en dessous des textes ou propositions.
Et, folle envie de ma part :p, j'aimerais que ça s'affiche différemment.
ça ne s'appelle plus un MsgBox mais un userform
upload_2017-11-30_11-27-23.png

VB:
Private Sub Worksheet_SelectionChange(ByVal R As Range)
If Not Intersect(R, Range("f8:f28")) Is Nothing And R.Count = 1 Then
    UserForm1.Show
    ' -----traitement de la réponse
    End If
End Sub
upload_2017-11-30_11-17-38.png
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, le forum

@arthour973
Est-ce que le jeu en vaut la chandelle?
Donc une MsgBox émancipée grâce aux API Windows
(et à mes archives anglophones)
Copie tout le code VBA ci dessous et lancer la bien nommée macro UneMsgBoxPasCommeLesAutres
VB:
Option Explicit

Private Declare Function GetCurrentThreadId Lib "kernel32" _
() As Long
Public Declare Function GetDesktopWindow Lib "user32" _
() As Long
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function MessageBox Lib "user32" _
Alias "MessageBoxA" _
(ByVal hWnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType As Long) 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 SetWindowText Lib "user32" _
Alias "SetWindowTextA" _
(ByVal hWnd As Long, _
ByVal lpString As String) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long

Private Const IDPROMPT = &HFFFF&
Private Const WH_CBT = 5
Private Const GWL_HINSTANCE = (-6)
Private Const HCBT_ACTIVATE = 5

Private Type MSGBOX_HOOK_PARAMS
hWndOwner As Long
hHook As Long
End Type

Private MSGHOOK As MSGBOX_HOOK_PARAMS

Dim mbFlags As VbMsgBoxStyle
Dim mbFlags2 As VbMsgBoxStyle
Dim mTitle As String
Dim mPrompt As String
Dim But1 As String
Dim But2 As String
Dim But3 As String


'---------------------------------------------------------------------------
Public Function cMsgBox(hWnd As Long, _
mMsgbox As VbMsgBoxStyle, _
Title As String, _
Prompt As String, _
Optional mMsgIcon As VbMsgBoxStyle, _
Optional Button1 As String, _
Optional Button2 As String, _
Optional Button3 As String) As String
'---------------------------------------------------------------------------
' Function: Controls the display of the custom MsgBox and returns the
' selected button
' Synopsis: Sets supplied custom parameters and returns text of
' the button that was pressed as a string
'---------------------------------------------------------------------------
Dim mReturn As Long

mbFlags = mMsgbox
mbFlags2 = mMsgIcon
mTitle = Title
mPrompt = Prompt
But1 = Button1
But2 = Button2
But3 = Button3

'show the custom messagebox
mReturn = MessageBoxH(hWnd, GetDesktopWindow(), mbFlags Or mbFlags2)

'test which button of the 7 possible options has been pressed
Select Case mReturn
Case vbAbort
cMsgBox = But1
Case vbRetry
cMsgBox = But2
Case vbIgnore
cMsgBox = But3
Case vbYes
cMsgBox = But1
Case vbNo
cMsgBox = But2
Case vbCancel
cMsgBox = But3
Case vbOK
cMsgBox = But1
End Select

End Function

'-------------------------------------------------------------------------------
Public Function MessageBoxH(hWndThreadOwner As Long, _
hWndOwner As Long, _
mbFlags As VbMsgBoxStyle) As Long
'-------------------------------------------------------------------------------
' Function: Calls the hook
'-------------------------------------------------------------------------------
Dim hInstance As Long
Dim hThreadId As Long

hInstance = GetWindowLong(hWndThreadOwner, GWL_HINSTANCE)
hThreadId = GetCurrentThreadId()

With MSGHOOK
.hWndOwner = hWndOwner
.hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, hInstance, hThreadId)
End With

MessageBoxH = MessageBox(hWndOwner, Space$(120), Space$(120), mbFlags)

End Function

'-------------------------------------------------------------------------------
Public Function MsgBoxHookProc(ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
'-------------------------------------------------------------------------------
'Function: Formats and shows the custom messagebox
' Synopsis: Setups the window text
' Setups the dialog box text
' Checks which buttons have been added to messagebox (choice of 6
' combinations ofthe 7 buttons), then sets the button text
' accordingly
' Then removes the hook
'-------------------------------------------------------------------------------

If uMsg = HCBT_ACTIVATE Then
SetWindowText wParam, mTitle
SetDlgItemText wParam, IDPROMPT, mPrompt

Select Case mbFlags
Case vbAbortRetryIgnore
SetDlgItemText wParam, vbAbort, But1
SetDlgItemText wParam, vbRetry, But2
SetDlgItemText wParam, vbIgnore, But3
Case vbYesNoCancel
SetDlgItemText wParam, vbYes, But1
SetDlgItemText wParam, vbNo, But2
SetDlgItemText wParam, vbCancel, But3
Case vbOKOnly
SetDlgItemText wParam, vbOK, But1
Case vbRetryCancel
SetDlgItemText wParam, vbRetry, But1
SetDlgItemText wParam, vbCancel, But2
Case vbYesNo
SetDlgItemText wParam, vbYes, But1
SetDlgItemText wParam, vbNo, But2
Case vbOKCancel
SetDlgItemText wParam, vbOK, But1
SetDlgItemText wParam, vbCancel, But2
End Select
UnhookWindowsHookEx MSGHOOK.hHook
End If
MsgBoxHookProc = False
End Function
Sub UneMsgBoxPasCommeLesAutres()
Dim mReturn As String
mReturn = cMsgBox(1, _
vbYesNoCancel, _
"Personnaliser vos boutons", _
"C'est posssible grâce au API", _
, _
"Arthour973", _
"veut changer", _
"le Message")
cMsgBox 1, vbOKOnly, "Personnaliser vos boutons", "Vous avez cliquer sur le bouton: " & mReturn, , "OK, je note"
End Sub
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonsoir JM,

Merci de m'avoir répondu.
NON, le jeu n'en vaut pas la chandelle LOL
Mais j'aurais bien voulu savoir si c'est possible car pour d'autres msgbox, peut-être .... ???
Merci aussi pour ton code.
Je vais regarder dès que j'ai un moment et je reviendrai :)

Bonne fin de journée à toutes et à tous,
Amicalement,
Lionel,
 

Si...

XLDnaute Barbatruc
Bon_jour

Je fais peut-être fausse route comme ici … mais voici deux exemples à ma sauce (le second pour le Fun, n'est-ce pas Stapple dont laproposition fonctionne bien avec mon 2010 ?)
 

Pièces jointes

  • Usf (non_oui).xlsm
    19.9 KB · Affichages: 60
  • Usf (oui_non).xlsm
    22.7 KB · Affichages: 48

Discussions similaires

Réponses
7
Affichages
949
Réponses
18
Affichages
1 K