Message box option

Pauljj

Well-known Member
Joined
Mar 28, 2004
Messages
2,047
I wanto to have a message box that asks if you want to print Landscape or Portrait, how can I get those words to appear in my message box instead of YES, NO or the other variables ??
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
I don't think you can - one option would be to create your own custom userform to do this with a couple of buttons saying "Landscape" and "Portrait".
 
Upvote 0
Thanks for getting back, a little beyond my capabilities though, Ill try a different way

Thanks anyhow
 
Upvote 0
It's possible.

Paste the below code into a standard module and run (then modify with your own code where indicated in the message box prompts) the macro named TestCustomMessageBox.

If it were me, I'd still opt for the userform, a lot less overhead, but here's how to do it in code using API:



Code:
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 TestCustomMessageBox()
Dim CustomText As String
CustomText = BBmsgbox(1, 3, "Select orientation preference", _
"Click the button that indicates your print orientation preference:", _
64, "Portrait", "Landscape", "Cancel")
Select Case CustomText
Case "Portrait"
MsgBox "Insert your related action code here.", 64, "You clicked the ''" + CustomText & "'' button."
Case "Landscape"
MsgBox "Insert your related action code here.", 64, "You clicked the ''" + CustomText & "'' button."
Case Else
MsgBox "Example's equivalent of Cancel." & vbCrLf & _
"Insert your related Cancel code here or end the Sub.", 64, "You clicked the ''" + CustomText & "'' or ''X'' close button."
End Select
End Sub
 
Upvote 0
Tom, that's cool! Being a (very) simple soul, I would go the Userform, but I like seeing how you *could* do what Paul asked :-D
 
Upvote 0
Couldn't resist.... :roll:
Code:
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 TestCustomMessageBox()
Dim CustomText As String

    CustomText = BBmsgbox(1, 3, "Select orientation preference", _
            "Click the button that indicates your print orientation preference:", _
            64, "Portrait", "Landscape", "Cancel")

    Select Case CustomText
        Case "Portrait"
            MsgBox "Insert your related action code here.", 64, _
            "You clicked the ''" + CustomText & "'' button."
        Case "Landscape"
            MsgBox "Insert your related action code here.", 64, _
            "You clicked the ''" + CustomText & "'' button."
        Case Else
            MsgBox "Example's equivalent of Cancel." & vbCrLf & _
            "Insert your related Cancel code here or end the Sub.", _
            64, "You clicked the ''" + CustomText & "'' or ''X'' close button."
    End Select
    
End Sub

:-D
 
Upvote 0
.........blimey

What can I say, I would try to understand it but maybe another day


Thanks everyone
 
Upvote 0

Forum statistics

Threads
1,224,551
Messages
6,179,470
Members
452,915
Latest member
hannnahheileen

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top