Results 1 to 7 of 7

Thread: Custom button captions in standard MsgBox - not a question
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    MrExcel MVP Tom Urtis's Avatar
    Join Date
    Feb 2002
    Location
    San Francisco, California USA
    Posts
    11,192
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    2 Thread(s)

    Default Custom button captions in standard MsgBox - not a question

    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...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

  2. #2
    MrExcel MVP Ivan F Moala's Avatar
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    4,209
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hi Tom, yes that was covered here;

    http://www.mrexcel.com/board2/viewto...=49224&start=8

    and basically involves Sub Classing or Hooking ......It basically just intercepts the Windows msgs and redirects it to your Function via the use of the Hook function. BUT it needs the address of the procedure to be passed to the Windows API function in a dynamic-link library (DLL), rather passing the procedure's return value, hence the AddressOf operator. Note this was introduced in Xl2000+ so Will NOT work in it's current form with Excel 97. I did a work around for this using the Great work of Ken Getz and Micheal Kaplan here

    Excel97 Work around
    http://www.mrexcel.com/board2/viewto...=49224&start=8

    Excel97 Work around
    http://www.mrexcel.com/board2/viewto...=49224&start=8
    Kind Regards,
    Ivan F Moala From the City of Sails

  3. #3
    MrExcel MVP Tom Urtis's Avatar
    Join Date
    Feb 2002
    Location
    San Francisco, California USA
    Posts
    11,192
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Custom button captions in standard MsgBox - not a questi

    Thank you Ivan...I did a search here but simply missed it then. I also made a point to search your site before posting, but did not see it, so maybe I missed it there too. Nice to see the '97 workaround. I'd still opt for the userform approach...it's a lot less top-heavy, but it's interesting to see how standard message boxes can be manipulated. Thanks again.

  4. #4
    MrExcel MVP Ivan F Moala's Avatar
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    4,209
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Custom button captions in standard MsgBox - not a questi

    Hi Tom

    Yes I agree, it is long winded, BUT....I like the fact that it can be done
    and it is a good exercise in Hooking. I actually don't have this on my site yet as I was looking at also changing the Fonts and Colour.
    Also note that if your msg is long or has Crlf you will need to change

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

    to handle the extra text....AND this will WIDEN the TextBox..

    I'd personally use a Userform....
    Kind Regards,
    Ivan F Moala From the City of Sails

  5. #5
    MrExcel MVP Tom Urtis's Avatar
    Join Date
    Feb 2002
    Location
    San Francisco, California USA
    Posts
    11,192
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Custom button captions in standard MsgBox - not a questi

    Quote Originally Posted by Ivan F Moala
    Also note that if your msg is long or has Crlf you will need to change
    MessageBoxH = MessageBox(hwndOwner, Space$(120), Space$(120), mbFlags)
    to handle the extra text....AND this will WIDEN the TextBox..

    I'd personally use a Userform.... :-)
    Me too regarding the userform.

    You know what - - I'm glad you mentioned the CrLf issue because I tried to do that before posting and could not; the new line text simply disappeared. Thanks for mentioning that.

    The other thing I wondered about is how to make the buttons themselves larger. Their size mandates a limited length of caption text, further beckoning the userform approach with flexible command buttons.

  6. #6
    New Member
    Join Date
    Oct 2009
    Posts
    1
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Custom button captions in standard MsgBox - not a questi

    Quote Originally Posted by Tom Urtis View Post
    Me too regarding the userform.

    You know what - - I'm glad you mentioned the CrLf issue because I tried to do that before posting and could not; the new line text simply disappeared. Thanks for mentioning that.

    The other thing I wondered about is how to make the buttons themselves larger. Their size mandates a limited length of caption text, further beckoning the userform approach with flexible command buttons.
    Dear Tom!
    If I use Excel 2003, I want Hook buttons on Msgbox with caption is Unicode (ex: ChrW(272) & ChrW(7891) & "ng"). How i do?
    Thanks!

  7. #7
    New Member shamsololama's Avatar
    Join Date
    Aug 2009
    Location
    IRAN
    Posts
    3
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Custom button captions in standard MsgBox - not a question

    Thanks
    it was good

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •