Change the language of Yes/No buttons in vba dialo

2019-07-13 20:41发布

Is it possible to change the language of Yes/No buttons in standard vba dialog box ? See the code below:

If MsgBox("Bla bla bla question", vbYesNo) = vbYes Then ...

标签: vba dialog
3条回答
SAY GOODBYE
2楼-- · 2019-07-13 20:58
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

This works

查看更多
ゆ 、 Hurt°
3楼-- · 2019-07-13 21:11

Try using Userform, as explained in this link

查看更多
ゆ 、 Hurt°
4楼-- · 2019-07-13 21:16

instead of changing the language of the yes/no msgbox, you could instead create a user form which can accomplish the same task.

A suggestion of how you could do this:
Create a User Form in your MS Office file, and create two command boxes.
Change the boxes to be Yes/No in your desired language.
Insert a label, and you don't need to bother editing the text in it.

Now, you should add code to your user form. Here, I use the default names for each 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

This code makes bool and Question publicly accessible to read/write to.
When the form is activated, it replaces the text in Label1 with whatever you set the variable Question to.
Clicking either yes or no will now return True or False based on your answer.

Next, let's create a basic function to call it.

Function yesno(Question As String)
    UserForm1.Question = Question
    UserForm1.Show
    While UserForm1.Visible = True
        DoEvents
    Wend
    yesno = UserForm2.bool
End Function

This function prompts the new UserForm to appear, and will return True/False after you answer.

 Sub test()
     Cells(1, 1) = yesno("Insert Question Here")
 End Sub

Lastly, this code just tests that we successfully made a working function, and will place your answer(True/False) in the ActiveSheet's Cell(1,1)


Hope this helps, and I recommend reading up on userforms through the link mentioned in another answer: UserForms

查看更多
登录 后发表回答