更改 vba 对话框中 Yes/No 按钮的语言
Change the language of Yes/No buttons in vba dialog
是否可以更改标准 vba 对话框中 Yes/No 按钮的语言？请参阅下面的代码：
If MsgBox("Bla bla bla question", vbYesNo) = vbYes Then ...
尝试使用 Userform，如 this link
中所述
Option Explicit
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
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
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 cMsgBox(hWnd As Long, _
mMsgbox As VbMsgBoxStyle, _
Title As String, _
Prompt As String, _
Optional mMsgIcon As VbMsgBoxStyle, _
Optional Button1 As String, _
Optional Button2 As String, _
Optional Button3 As String) As String
'---------------------------------------------------------------------------
' Function: Controls the display of the custom MsgBox and returns the
' selected button
' Synopsis: Sets supplied custom parameters and returns text of
' the button that was pressed as a string
'---------------------------------------------------------------------------
Dim mReturn As Long
mbFlags = mMsgbox
mbFlags2 = mMsgIcon
mTitle = Title
mPrompt = Prompt
But1 = Button1
But2 = Button2
But3 = Button3
'show the custom messagebox
mReturn = MessageBoxH(hWnd, GetDesktopWindow(), mbFlags Or mbFlags2)
'test which button of the 7 possible options has been pressed
Select Case mReturn
Case vbAbort
cMsgBox = But1
Case vbRetry
cMsgBox = But2
Case vbIgnore
cMsgBox = But3
Case vbYes
cMsgBox = But1
Case vbNo
cMsgBox = But2
Case vbCancel
cMsgBox = But3
Case vbOK
cMsgBox = But1
End Select
End Function
'-------------------------------------------------------------------------------
Public Function MessageBoxH(hWndThreadOwner As Long, _
hWndOwner As Long, _
mbFlags As VbMsgBoxStyle) As Long
'-------------------------------------------------------------------------------
' Function: Calls the hook
'-------------------------------------------------------------------------------
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
'-------------------------------------------------------------------------------
'Function: Formats and shows the custom messagebox
' Synopsis: Setups the window text
' Setups the dialog box text
' Checks which buttons have been added to messagebox (choice of 6
' combinations ofthe 7 buttons), then sets the button text
' accordingly
' Then removes the hook
'-------------------------------------------------------------------------------
If uMsg = HCBT_ACTIVATE Then
SetWindowText wParam, mTitle
SetDlgItemText wParam, IDPROMPT, mPrompt
Select Case mbFlags
Case vbAbortRetryIgnore
SetDlgItemText wParam, vbAbort, But1
SetDlgItemText wParam, vbRetry, But2
SetDlgItemText wParam, vbIgnore, But3
Case vbYesNoCancel
SetDlgItemText wParam, vbYes, But1
SetDlgItemText wParam, vbNo, But2
SetDlgItemText wParam, vbCancel, But3
Case vbOKOnly
SetDlgItemText wParam, vbOK, But1
Case vbRetryCancel
SetDlgItemText wParam, vbRetry, But1
SetDlgItemText wParam, vbCancel, But2
Case vbYesNo
SetDlgItemText wParam, vbYes, But1
SetDlgItemText wParam, vbNo, But2
Case vbOKCancel
SetDlgItemText wParam, vbOK, But1
SetDlgItemText wParam, vbCancel, But2
End Select
UnhookWindowsHookEx MSGHOOK.hHook
End If
MsgBoxHookProc = False
End Function
Sub Test()
Dim mReturn As String
mReturn = cMsgBox(1, _
vbYesNoCancel, _
"Customize your message box buttons", _
"Do you not agree that this is pretty cool?", _
, _
"shat lav er", _
"durs chekav", _
"der harcer kan")
cMsgBox 1, _
vbOKOnly, _
"Customize your message box buttons", _
"You selected the '" & mReturn & " 'button", _
, _
"Okay"
End Sub
Sub test2()
Dim a
Dim ary
ary = Array("vbOKOnly", "vbOK", "vbCancel", "vbAbort", "vbRetry", "vbIgnore", "vbYes", "vbNo")
a = MsgBox("Hello", vbAbortRetryIgnore)
MsgBox (ary(a))
End Sub
这个有效
您可以创建一个可以完成相同任务的用户表单，而不是更改 yes/no 消息框的语言。
有关如何执行此操作的建议：
在您的 MS Office 文件中创建一个用户窗体，并创建两个命令框。
将框更改为所需语言的 Yes/No。
插入一个标签，你就不用费心编辑里面的文字了。
现在，您应该将代码添加到您的用户表单中。在这里，我为每个 object/Userform.
使用默认名称
Public bool As Boolean
Public Question As String
Private Sub UserForm_Activate()
Label1.Caption = Question
End Sub
Private Sub CommandButton1_Click()
'Yes box
bool = True
Me.Hide
End Sub
Private Sub CommandButton2_Click()
'No box
bool = False
Me.Hide
End Sub
此代码使 bool 和 Question 可供 read/write 公开访问。
激活表单后，它会将 Label1 中的文本替换为您将变量 Question 设置为的内容。
单击是或否现在将 return 根据您的回答判断对或错。
接下来，让我们创建一个基本函数来调用它。
Function yesno(Question As String)
UserForm1.Question = Question
UserForm1.Show
While UserForm1.Visible = True
DoEvents
Wend
yesno = UserForm2.bool
End Function
此函数提示新的用户窗体出现，并会在您回答后return True/False。
Sub test()
Cells(1, 1) = yesno("Insert Question Here")
End Sub
最后，这段代码只是测试我们是否成功制作了一个有效的功能，并将您的答案（True/False）放在 ActiveSheet 的 Cell(1,1)
中
希望这有帮助，我建议通过另一个答案中提到的 link 阅读用户表单：UserForms
是否可以更改标准 vba 对话框中 Yes/No 按钮的语言？请参阅下面的代码：
If MsgBox("Bla bla bla question", vbYesNo) = vbYes Then ...
尝试使用 Userform，如 this link
Option Explicit
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
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
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 cMsgBox(hWnd As Long, _
mMsgbox As VbMsgBoxStyle, _
Title As String, _
Prompt As String, _
Optional mMsgIcon As VbMsgBoxStyle, _
Optional Button1 As String, _
Optional Button2 As String, _
Optional Button3 As String) As String
'---------------------------------------------------------------------------
' Function: Controls the display of the custom MsgBox and returns the
' selected button
' Synopsis: Sets supplied custom parameters and returns text of
' the button that was pressed as a string
'---------------------------------------------------------------------------
Dim mReturn As Long
mbFlags = mMsgbox
mbFlags2 = mMsgIcon
mTitle = Title
mPrompt = Prompt
But1 = Button1
But2 = Button2
But3 = Button3
'show the custom messagebox
mReturn = MessageBoxH(hWnd, GetDesktopWindow(), mbFlags Or mbFlags2)
'test which button of the 7 possible options has been pressed
Select Case mReturn
Case vbAbort
cMsgBox = But1
Case vbRetry
cMsgBox = But2
Case vbIgnore
cMsgBox = But3
Case vbYes
cMsgBox = But1
Case vbNo
cMsgBox = But2
Case vbCancel
cMsgBox = But3
Case vbOK
cMsgBox = But1
End Select
End Function
'-------------------------------------------------------------------------------
Public Function MessageBoxH(hWndThreadOwner As Long, _
hWndOwner As Long, _
mbFlags As VbMsgBoxStyle) As Long
'-------------------------------------------------------------------------------
' Function: Calls the hook
'-------------------------------------------------------------------------------
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
'-------------------------------------------------------------------------------
'Function: Formats and shows the custom messagebox
' Synopsis: Setups the window text
' Setups the dialog box text
' Checks which buttons have been added to messagebox (choice of 6
' combinations ofthe 7 buttons), then sets the button text
' accordingly
' Then removes the hook
'-------------------------------------------------------------------------------
If uMsg = HCBT_ACTIVATE Then
SetWindowText wParam, mTitle
SetDlgItemText wParam, IDPROMPT, mPrompt
Select Case mbFlags
Case vbAbortRetryIgnore
SetDlgItemText wParam, vbAbort, But1
SetDlgItemText wParam, vbRetry, But2
SetDlgItemText wParam, vbIgnore, But3
Case vbYesNoCancel
SetDlgItemText wParam, vbYes, But1
SetDlgItemText wParam, vbNo, But2
SetDlgItemText wParam, vbCancel, But3
Case vbOKOnly
SetDlgItemText wParam, vbOK, But1
Case vbRetryCancel
SetDlgItemText wParam, vbRetry, But1
SetDlgItemText wParam, vbCancel, But2
Case vbYesNo
SetDlgItemText wParam, vbYes, But1
SetDlgItemText wParam, vbNo, But2
Case vbOKCancel
SetDlgItemText wParam, vbOK, But1
SetDlgItemText wParam, vbCancel, But2
End Select
UnhookWindowsHookEx MSGHOOK.hHook
End If
MsgBoxHookProc = False
End Function
Sub Test()
Dim mReturn As String
mReturn = cMsgBox(1, _
vbYesNoCancel, _
"Customize your message box buttons", _
"Do you not agree that this is pretty cool?", _
, _
"shat lav er", _
"durs chekav", _
"der harcer kan")
cMsgBox 1, _
vbOKOnly, _
"Customize your message box buttons", _
"You selected the '" & mReturn & " 'button", _
, _
"Okay"
End Sub
Sub test2()
Dim a
Dim ary
ary = Array("vbOKOnly", "vbOK", "vbCancel", "vbAbort", "vbRetry", "vbIgnore", "vbYes", "vbNo")
a = MsgBox("Hello", vbAbortRetryIgnore)
MsgBox (ary(a))
End Sub
这个有效
您可以创建一个可以完成相同任务的用户表单，而不是更改 yes/no 消息框的语言。
有关如何执行此操作的建议：
在您的 MS Office 文件中创建一个用户窗体，并创建两个命令框。
将框更改为所需语言的 Yes/No。
插入一个标签，你就不用费心编辑里面的文字了。
现在，您应该将代码添加到您的用户表单中。在这里，我为每个 object/Userform.
使用默认名称Public bool As Boolean
Public Question As String
Private Sub UserForm_Activate()
Label1.Caption = Question
End Sub
Private Sub CommandButton1_Click()
'Yes box
bool = True
Me.Hide
End Sub
Private Sub CommandButton2_Click()
'No box
bool = False
Me.Hide
End Sub
此代码使 bool 和 Question 可供 read/write 公开访问。
激活表单后，它会将 Label1 中的文本替换为您将变量 Question 设置为的内容。
单击是或否现在将 return 根据您的回答判断对或错。
接下来，让我们创建一个基本函数来调用它。
Function yesno(Question As String)
UserForm1.Question = Question
UserForm1.Show
While UserForm1.Visible = True
DoEvents
Wend
yesno = UserForm2.bool
End Function
此函数提示新的用户窗体出现，并会在您回答后return True/False。
Sub test()
Cells(1, 1) = yesno("Insert Question Here")
End Sub
最后，这段代码只是测试我们是否成功制作了一个有效的功能，并将您的答案（True/False）放在 ActiveSheet 的 Cell(1,1)
中希望这有帮助，我建议通过另一个答案中提到的 link 阅读用户表单：UserForms