Here's a message box replacement that allows you to replace the text on the command buttons. As is, it requires you to pass the new text as an array of strings. With some minor tweaking you can pull those text strings from a resource file.
Option Explicit
Dim But(1 To 7, 1 To 2) As Integer
Dim bn(1 To 3) As String
'VBnet-defined control ID for the message prompt
Private Const IDPROMPT = &HFFFF&
'misc constants
Private Const WH_CBT = 5
Private Const GWL_HINSTANCE = (-6)
Private Const HCBT_ACTIVATE = 5
Public Type HookParms
WindowOwner As Long
xPos As Long
yPos As Long
hHook As Long
End Type
'UDT for passing data through the hook
Private Type MSGBOX_HOOK_PARAMS
hwndOwner As Long
hHook As Long
End Type
'need this declared at module level as
'it is used in the call and the hook proc
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
Public Function MsgBoxCaption(ByVal sCaption As String, _
Optional ByVal lParms As VbMsgBoxStyle = vbInformation, _
Optional ByVal sTitle As Variant = " ", _
Optional ByVal ButtonCount As Integer = 2, _
Optional ByRef ButtonNames As Variant, _
Optional ByVal lOwner As Variant) As Long
'Wrapper function for the MessageBox API
Dim hInstance As Long
Dim hThreadId As Long
Dim rv As Long
Dim n As Integer
Dim ButSel As Integer
Dim TheOwner As Long
On Error GoTo ErrorProc
'Figure out who owns the message box
If IsMissing(lOwner) Then
TheOwner = "&h" & Hex(0) ' Owner zero is the desktop.
ElseIf VarType(lOwner) = vbLong Then
TheOwner = "&h" & Hex(lOwner) ' Got a window handle as the owner.
ElseIf TypeOf lOwner Is Form Then
TheOwner = lOwner.hWnd ' Got a form as the owner. Pick up the handle.
End If
hInstance = GetWindowLong(TheOwner, GWL_HINSTANCE)
hThreadId = GetCurrentThreadId()
' Initialize all buttons to 'False' (i.e. not displayed)
For n = 1 To 7
But(n, 1) = False
But(n, 2) = 0
Next
' Copy the button names to a public array.
' Raise Errors if its not an array or does not have enough names.
If (VarType(ButtonNames) And vbArray) <> vbArray Then
Err.Raise 1050, "modMsgBoxRev", "Button Names must be an array"
Else
If UBound(ButtonNames, 1) < ButtonCount Then
Err.Raise 1051, "modMsgBoxRev", "Not Enough Button Names Supplied"
End If
End If
For n = 1 To UBound(ButtonNames, 1)
bn
= ButtonNames
Next
' Figure out which buttons are displayed
If (lParms And vbRetryCancel) = vbRetryCancel Then
ButSel = vbRetryCancel
ElseIf (lParms And vbYesNo) = vbYesNo Then
ButSel = vbYesNo
ElseIf (lParms And vbYesNoCancel) = vbYesNoCancel Then
ButSel = vbYesNoCancel
ElseIf (lParms And vbAbortRetryIgnore) = vbAbortRetryIgnore Then
ButSel = vbAbortRetryIgnore
ElseIf (lParms And vbOKCancel) = vbOKCancel Then
ButSel = vbOKCancel
Else
ButSel = vbOK
End If
' Reset the parameters by removing the one they specified and
' adding one that provides 1, 2 or 3 buttons. Keep track of
' the buttons by consecutively numbering them from left to right.
If ButtonCount <= 1 Then
lParms = lParms - ButSel + vbOKOnly
But(vbOK, 1) = True
But(vbOK, 2) = 1
ElseIf ButtonCount = 2 Then
lParms = lParms - ButSel + vbYesNo
But(vbYes, 1) = True
But(vbNo, 1) = True
But(vbYes, 2) = 1
But(vbNo, 2) = 2
Else
lParms = lParms - ButSel + vbAbortRetryIgnore
But(vbAbort, 1) = True
But(vbRetry, 1) = True
But(vbIgnore, 1) = True
But(vbAbort, 2) = 1
But(vbRetry, 2) = 2
But(vbIgnore, 2) = 3
End If
'set up the MSGBOX_HOOK_PARAMS values
'By specifying a Windows hook as one
'of the params, we can intercept messages
'sent by Windows and thereby manipulate
'the dialog
With MSGHOOK
.hwndOwner = TheOwner
.hHook = SetWindowsHookEx(WH_CBT, _
AddressOf MBHooker, _
hInstance, hThreadId)
End With
' Message box returns a button number that is one of vbOK, vbYes, vbNo, etc.
' We need to translate those to the button number as displayed
' across the screen (Left = 1, Centre = 2, Right = 3)
rv = MessageBox(TheOwner, sCaption, sTitle, lParms)
MsgBoxCaption = But(rv, 2)
' If you want to return the standard Message Box button numbers then use
' MsgBoxCaption = rv
Exit Function
ErrorProc:
If Err.Number = 1050 Then
MsgBox Err.Description, vbCritical + vbOKOnly, "Array Required"
ElseIf Err.Number = 1051 Then
MsgBox Err.Description, vbCritical + vbOKOnly, "Not Enough Names"
Else
MsgBox Err.Number & " - " & Err.Description
End If
End Function
Public Function MBHooker(ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim n As Long
Dim nBut As Integer
If uMsg = HCBT_ACTIVATE Then
' Set the caption for each of the displayed buttons
nBut = 0
For n = LBound(But, 1) To UBound(But, 1)
If But(n, 1) Then
nBut = nBut + 1
SetDlgItemText wParam, n, bn(nBut)
' Alternatively, you could load these button values from a
' resource file with a statement like:
'
' SetDlgItemText wParam, n, LoadResString (n + OffSet)
'
' Where 'OffSet' positions to the language that you are using.
End If
Next
'we're done with the dialog, so release the hook
UnhookWindowsHookEx MSGHOOK.hHook
End If
'return False to let normal processing continue
MBHooker = False
End Function
'--end block--'
Good Luck.
