メッセージボックスのボタンの文字を変更する。
VBAのMsgBox関数で表示される「Yes」や「キャンセル」などのボタン文字を変更するにはAPIのSetWindowsHookEx関数やCallNextHookEx関数などを利用しフックをします。
※フック(hook)とは通常処理の中に独自処理を割り込ませて追加できるようにする仕組みフックと言います。（詳細を説明すると複雑になるので割愛します。）
メッセージボックスを表示する前にフック処理を呼び出すことでボタンの表示を変更することができます。
サンプルコードではフック処理のなかでフック解除処理(UnhookWindowsHookEx)を実行しているので、フックの影響はフック処理が呼び出された範囲でしか影響しません。
'API関数宣言
#If Win64 Then
Private Declare PtrSafe 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 PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare PtrSafe Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function SetDlgItemText Lib "user32.dll" Alias "SetDlgItemTextA" _
(ByVal hDlg As Long, ByVal nIDDlgItem As MSGBOXCTRLID, ByVal lpString As String) As Long
#Else
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 UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function SetDlgItemText Lib "user32.dll" Alias "SetDlgItemTextA" _
(ByVal hDlg As Long, ByVal nIDDlgItem As MSGBOXCTRLID, ByVal lpString As String) As Long
#End If
'定数宣言
Private Const WH_CBT As Long = 5
Private Const HCBT_ACTIVATE As Long = 5
Private Const MAX_PATH As Long = 256
'変数宣言
Private mhHook As Long
'Msgbox ControlID
Public Enum MSGBOXCTRLID
MSGBTN_OK = &H1
MSGBTN_CANCEL = &H2
MSGBTN_ABORT = &H3
MSGBTN_RETRY = &H4
MSGBTN_IGNORE = &H5
MSGBTN_YES = &H6
MSGBTN_No = &H7
End Enum
'******************************************************************************
' ボタンのテキストをフックする
'******************************************************************************
Sub Main_MsgBoxHook()
'MsgBoxの直前でフックプロシージャを呼び出してテキストを書き換えます
mhHook = SetWindowsHookEx(WH_CBT, AddressOf hookMsgboxProc, 0&, GetCurrentThreadId)
Call MsgBox("ボタンの表示を変えました。", vbOKCancel) '実行結果①
mhHook = SetWindowsHookEx(WH_CBT, AddressOf hookMsgboxProc, 0&, GetCurrentThreadId)
Call MsgBox("ボタンの表示を変えました。", vbAbortRetryIgnore) '実行結果②
mhHook = SetWindowsHookEx(WH_CBT, AddressOf hookMsgboxProc, 0&, GetCurrentThreadId)
Call MsgBox("ボタンの表示を変えました。", vbYesNo) '実行結果③
'hookMsgboxProcプロシージャでUnhookしているので、事前にhookしていない場合の表示は変わらない
Call MsgBox("ボタンの表示が戻りました。", vbYesNoCancel) '実行結果④
End Sub
'******************************************************************************
' MSGBOXフックプロシージャ
'******************************************************************************
Function hookMsgboxProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim sClassName As String
Dim lRet As Long
If lMsg = HCBT_ACTIVATE Then
sClassName = Space(MAX_PATH)
lRet = GetClassName(wParam, sClassName, MAX_PATH)
If Left(sClassName, lRet) = "#32770" Then
SetDlgItemText wParam, MSGBTN_OK, "コーヒー"
SetDlgItemText wParam, MSGBTN_CANCEL, "紅茶"
SetDlgItemText wParam, MSGBTN_ABORT, "牛"
SetDlgItemText wParam, MSGBTN_RETRY, "豚"
SetDlgItemText wParam, MSGBTN_IGNORE, "鳥"
SetDlgItemText wParam, MSGBTN_YES, "ごはん"
SetDlgItemText wParam, MSGBTN_No, "パン"
UnhookWindowsHookEx mhHook
End If
End If
CallNextHookEx mhHook, lMsg, wParam, lParam
End Function
■実行結果
