How do I change the names of buttons on a message box?

Question

I am looking to write a macro that executes on opening the spreadsheet and displays a message box with three buttons with custom text on them. When the user clicks on one of the buttons it will execute another macro depending on which button is pressed.

I've found out how to run the macro upon opening and how to code a msg box, but not with custom text.

Is this possible?

Answer 1

I copied this code from a forum (Mr Excel, I think) many years ago - you might have to play with the declarations to suit your VBA and Windows.

I do recall using this code a fair bit in the past. I'm embarrassed to say it was a blatant case of cargo cult programming and I made no effort to learn about the hooking that is used in the code. Siddharth Rout's advice is worth heeding if you wish to employ these procedures. In any event, guilt got the better of me and I switched to using custom Userforms, as Jeeped suggests.

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()
    Const MY_YES As String = "Aye"
    Const MY_NO As String = "Nay"
    Dim DialogResult As String

    DialogResult = BBmsgbox(1, vbYesNo, "[Title here]", "[Prompt here]", vbInformation, MY_YES, MY_NO)

    Select Case DialogResult
        Case MY_YES: MsgBox MY_YES & " = vbYes"
        Case MY_NO: MsgBox MY_NO & " = vbNo"
    End Select
End Sub