Tom Urtis
MrExcel MVP
- Joined
- Feb 10, 2002
- Messages
- 11,305
Hello everyone - -
If this topic has been posted on MrExcel previously or you already know about this, sorry for the redundancy.
Sometimes the question comes up about how, if it's even possible, to create a message box with customized button captions, instead of the standard Yes, No, Cancel, Abort, Retry, Ignore, and OK buttons. The usual response is to create a userform.
I came across this code posted on PlanetSourceCode, at the url
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=21772&lngWId=1
which shows how it can be done. Because the link involves a download and some people reading this may not have download permissions at their work computers, the essence of the code is below.
My (very) modest contribution to this is the TestYNC macro which can be attached to a button or drawing object as usual, to call the API that makes the button manipulation possible. I put a Select Case structure in the TestYNC macro, where code or Sub calls would go, to correspond to which button was clicked.
I do not know the original author of the API, so I do not know who to credit; I only know it wasn't me.
I wonder if a userform is a better bet anyway, given all the code involved to accomplish something for a message box that is easy to do with a userform. The code goes into a standard VBA module...this example shows how to customize the 3 captions for a Yes No Cancel message box. This worked for me when I tested it in XL2K2 on WXP.
I'd be interested in anyone's comments, especially if you experience problems with it, or if you see something in the code that would make you anticipate the possibility of problems.
Option Explicit
Private Const MB_YESNOCANCEL = &H3&
Private Const MB_YESNO = &H4&
Private Const MB_RETRYCANCEL = &H5&
Private Const MB_OKCANCEL = &H1&
Private Const MB_OK = &H0&
Private Const MB_ABORTRETRYIGNORE = &H2&
Private Const MB_ICONEXCLAMATION = &H30&
Private Const MB_ICONQUESTION = &H20&
Private Const MB_ICONASTERISK = &H40&
Private Const MB_ICONINFORMATION = MB_ICONASTERISK
Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const IDABORT = 3
Private Const IDRETRY = 4
Private Const IDIGNORE = 5
Private Const IDYES = 6
Private Const IDNO = 7
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
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
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 MessageBoxH(hwndThreadOwner As Long, _
hwndOwner As Long, mbFlags As VbMsgBoxStyle) As Long
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
If uMsg = HCBT_ACTIVATE Then
SetWindowText wParam, mTitle
SetDlgItemText wParam, IDPROMPT, mPrompt
Select Case mbFlags
Case vbAbortRetryIgnore
SetDlgItemText wParam, IDABORT, But1
SetDlgItemText wParam, IDRETRY, But2
SetDlgItemText wParam, IDIGNORE, But3
Case vbYesNoCancel
SetDlgItemText wParam, IDYES, But1
SetDlgItemText wParam, IDNO, But2
SetDlgItemText wParam, IDCANCEL, But3
Case vbOKOnly
SetDlgItemText wParam, IDOK, But1
Case vbRetryCancel
SetDlgItemText wParam, IDRETRY, But1
SetDlgItemText wParam, IDCANCEL, But2
Case vbYesNo
SetDlgItemText wParam, IDYES, But1
SetDlgItemText wParam, IDNO, But2
Case vbOKCancel
SetDlgItemText wParam, IDOK, But1
SetDlgItemText wParam, IDCANCEL, But2
End Select
UnhookWindowsHookEx MSGHOOK.hHook
End If
MsgBoxHookProc = False
End Function
Public Function BBmsgbox(mhwnd As Long, _
mMsgbox As VbMsgBoxStyle, Title As String, _
Prompt As String, Optional mMsgIcon As VbMsgBoxStyle, _
Optional ButA As String, Optional ButB As String, _
Optional ButC As String) As String
Dim CustomText As Long
mbFlags = mMsgbox
mbFlags2 = mMsgIcon
mTitle = Title
mPrompt = Prompt
But1 = ButA
But2 = ButB
But3 = ButC
CustomText = MessageBoxH(mhwnd, GetDesktopWindow(), mbFlags Or mbFlags2)
Select Case CustomText
Case IDABORT
BBmsgbox = But1
Case IDRETRY
BBmsgbox = But2
Case IDIGNORE
BBmsgbox = But3
Case IDYES
BBmsgbox = But1
Case IDNO
BBmsgbox = But2
Case IDCANCEL
BBmsgbox = But3
Case IDOK
BBmsgbox = But1
End Select
End Function
Sub TestYNC()
Dim CustomText As String
CustomText = BBmsgbox(1, 3, "Through the magic of API...", _
"Here are 3 custom text buttons on a Yes No Cancel message box:", _
64, "You da man", "Get serious", "I'm outa here")
Select Case CustomText
Case "You da man"
MsgBox "You clicked the ''" + CustomText & "'' button." & vbCrLf & _
"That is this example's equivalent of Yes." & vbCrLf & _
"Insert your related action code here."
Case "Get serious"
MsgBox "You clicked the ''" + CustomText & "'' button." & vbCrLf & _
"That is this example's equivalent of No." & vbCrLf & _
"Insert your related action code here."
Case Else
MsgBox "You clicked the ''" + CustomText & "'' or ''X'' close button." & vbCrLf & _
"That is this example's equivalent of Cancel." & vbCrLf & _
"Insert your related action code here or end the Sub."
End Select
End Sub
If this topic has been posted on MrExcel previously or you already know about this, sorry for the redundancy.
Sometimes the question comes up about how, if it's even possible, to create a message box with customized button captions, instead of the standard Yes, No, Cancel, Abort, Retry, Ignore, and OK buttons. The usual response is to create a userform.
I came across this code posted on PlanetSourceCode, at the url
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=21772&lngWId=1
which shows how it can be done. Because the link involves a download and some people reading this may not have download permissions at their work computers, the essence of the code is below.
My (very) modest contribution to this is the TestYNC macro which can be attached to a button or drawing object as usual, to call the API that makes the button manipulation possible. I put a Select Case structure in the TestYNC macro, where code or Sub calls would go, to correspond to which button was clicked.
I do not know the original author of the API, so I do not know who to credit; I only know it wasn't me.
I wonder if a userform is a better bet anyway, given all the code involved to accomplish something for a message box that is easy to do with a userform. The code goes into a standard VBA module...this example shows how to customize the 3 captions for a Yes No Cancel message box. This worked for me when I tested it in XL2K2 on WXP.
I'd be interested in anyone's comments, especially if you experience problems with it, or if you see something in the code that would make you anticipate the possibility of problems.
Option Explicit
Private Const MB_YESNOCANCEL = &H3&
Private Const MB_YESNO = &H4&
Private Const MB_RETRYCANCEL = &H5&
Private Const MB_OKCANCEL = &H1&
Private Const MB_OK = &H0&
Private Const MB_ABORTRETRYIGNORE = &H2&
Private Const MB_ICONEXCLAMATION = &H30&
Private Const MB_ICONQUESTION = &H20&
Private Const MB_ICONASTERISK = &H40&
Private Const MB_ICONINFORMATION = MB_ICONASTERISK
Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const IDABORT = 3
Private Const IDRETRY = 4
Private Const IDIGNORE = 5
Private Const IDYES = 6
Private Const IDNO = 7
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
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
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 MessageBoxH(hwndThreadOwner As Long, _
hwndOwner As Long, mbFlags As VbMsgBoxStyle) As Long
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
If uMsg = HCBT_ACTIVATE Then
SetWindowText wParam, mTitle
SetDlgItemText wParam, IDPROMPT, mPrompt
Select Case mbFlags
Case vbAbortRetryIgnore
SetDlgItemText wParam, IDABORT, But1
SetDlgItemText wParam, IDRETRY, But2
SetDlgItemText wParam, IDIGNORE, But3
Case vbYesNoCancel
SetDlgItemText wParam, IDYES, But1
SetDlgItemText wParam, IDNO, But2
SetDlgItemText wParam, IDCANCEL, But3
Case vbOKOnly
SetDlgItemText wParam, IDOK, But1
Case vbRetryCancel
SetDlgItemText wParam, IDRETRY, But1
SetDlgItemText wParam, IDCANCEL, But2
Case vbYesNo
SetDlgItemText wParam, IDYES, But1
SetDlgItemText wParam, IDNO, But2
Case vbOKCancel
SetDlgItemText wParam, IDOK, But1
SetDlgItemText wParam, IDCANCEL, But2
End Select
UnhookWindowsHookEx MSGHOOK.hHook
End If
MsgBoxHookProc = False
End Function
Public Function BBmsgbox(mhwnd As Long, _
mMsgbox As VbMsgBoxStyle, Title As String, _
Prompt As String, Optional mMsgIcon As VbMsgBoxStyle, _
Optional ButA As String, Optional ButB As String, _
Optional ButC As String) As String
Dim CustomText As Long
mbFlags = mMsgbox
mbFlags2 = mMsgIcon
mTitle = Title
mPrompt = Prompt
But1 = ButA
But2 = ButB
But3 = ButC
CustomText = MessageBoxH(mhwnd, GetDesktopWindow(), mbFlags Or mbFlags2)
Select Case CustomText
Case IDABORT
BBmsgbox = But1
Case IDRETRY
BBmsgbox = But2
Case IDIGNORE
BBmsgbox = But3
Case IDYES
BBmsgbox = But1
Case IDNO
BBmsgbox = But2
Case IDCANCEL
BBmsgbox = But3
Case IDOK
BBmsgbox = But1
End Select
End Function
Sub TestYNC()
Dim CustomText As String
CustomText = BBmsgbox(1, 3, "Through the magic of API...", _
"Here are 3 custom text buttons on a Yes No Cancel message box:", _
64, "You da man", "Get serious", "I'm outa here")
Select Case CustomText
Case "You da man"
MsgBox "You clicked the ''" + CustomText & "'' button." & vbCrLf & _
"That is this example's equivalent of Yes." & vbCrLf & _
"Insert your related action code here."
Case "Get serious"
MsgBox "You clicked the ''" + CustomText & "'' button." & vbCrLf & _
"That is this example's equivalent of No." & vbCrLf & _
"Insert your related action code here."
Case Else
MsgBox "You clicked the ''" + CustomText & "'' or ''X'' close button." & vbCrLf & _
"That is this example's equivalent of Cancel." & vbCrLf & _
"Insert your related action code here or end the Sub."
End Select
End Sub
