Set custom Buttons on standard MsgBox using API

I am looking at changing the text on the buttons of a standard MsgBox.

I found code here http://www.excely.com/excel-vba/chan...-buttons.shtml

But I ran (& also stepped through) the code and the buttons still show as Yes and No.

What I am doing wrong? (I am testing this on Windows 7 using Excel 2010 32 bits)

Solved. I found code here and it works http://www.mrexcel.com/forum/excel-q...-question.html

I haven't stopped to work out yet why this works and the first one didn't (This one involves a lot of code - I would have preferred to get the first version running).

heh. same

Still it's cool to see that you can do it this way if you want.

I'd be interested if any forum genius could get the first version (see post #1) to work + make it Office 64 bit compatible + use Hungarian Notation for all variables. I'll rep anyone who can pull this challenge off


In the meantime, I've been playing around with the alternative version (post #2). It is very clunky so I have cleaned it up slightly and made it easier to call (see below). Note that it won't be compatible with Macs (API calls) and it currently isn't compatible with Office 64 bit (I haven't converted the API yet).

Option Explicit
Option Private Module

'\ last updated 20130625

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 mbFlags     As VbMsgBoxStyle
Private mbFlags2    As VbMsgBoxStyle
Private mTitle      As String
Private mPrompt     As String
Private But1        As String
Private But2        As String
Private But3        As String

'API Calls (Need to make these 64 bit compatible)
Private Declare Function GetCurrentThreadId _
    Lib "kernel32" () As Long

Private 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

Public Function CustomMsgBox( _
                    ByRef Prompt As String, _
                    ByRef Title As String, _
                    ByRef strMsgButton1 As String, _
                    Optional ByRef strMsgButton2 As String, _
                    Optional ByRef strMsgButton3 As String, _
                    Optional ByRef MsgBoxIcon As VbMsgBoxStyle) As String

    Dim MsgButtonNumber     As VbMsgBoxStyle 'This used to be argument. I'd prefer to have the code set this value
    Dim CustomText          As Long
    Dim bytButtonNo         As Byte
    Const mhwnd             As Long = 1 'This used to be an argument. Can't work out what this does so I've moved it to here (seems to work regardless of value!)

'   set number of buttons
    bytButtonNo = 1
    If Len(strMsgButton2) > 0 Then bytButtonNo = bytButtonNo + 1
    If Len(strMsgButton3) > 0 Then bytButtonNo = bytButtonNo + 1

    If bytButtonNo = 1 Then '(Yes I know but for some reason Select Case just doesn't work here)
        MsgButtonNumber = 0 '= vbOKOnly?
    ElseIf bytButtonNo = 2 Then: MsgButtonNumber = 1 '= vbOKCancel?
    ElseIf bytButtonNo = 3 Then: MsgButtonNumber = 3 '= vbYesNoCancel?
    End If

    mbFlags = MsgButtonNumber
    mbFlags2 = MsgBoxIcon
    mTitle = Title
    mPrompt = Prompt
    But1 = strMsgButton1
    But2 = strMsgButton2
    But3 = strMsgButton3

    CustomText = MessageBoxH(mhwnd, GetDesktopWindow(), mbFlags Or mbFlags2)

    Select Case CustomText
        Case IDABORT:   CustomMsgBox = But1
        Case IDRETRY:   CustomMsgBox = But2
        Case IDIGNORE:  CustomMsgBox = But3
        Case IDYES:     CustomMsgBox = But1
        Case IDNO:      CustomMsgBox = But2
        Case IDCANCEL:  CustomMsgBox = But3
        Case IDOK:      CustomMsgBox = But1
    End Select
End Function

Private Function MessageBoxH(ByRef hwndThreadOwner As Long, _
                    ByRef hwndOwner As Long, _
                    ByRef 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

Private 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