Question

我希望编写一个在打开电子表格时执行的宏，并显示一个带有三个按钮的消息框，其中包含自定义文本。当用户点击其中一个按钮时，它将根据按下的按钮执行另一个宏。

我已经找到了如何在打开时运行宏以及如何编写msg框，而不是自定义文本。

这可能吗？

Answer 1

我多年前从一个论坛（ Excel ，我认为）中复制了这段代码 - 您可能必须使用适合您的VBA和Windows的声明。

我记得过去曾经使用过这段代码。我很尴尬地说这是一个明显的货物崇拜编程案例，我没有努力去了解代码中使用的钩子。如果您希望使用这些程序， Siddharth Rout的建议值得注意。无论如何，内疚对我越来越好，我转而使用自定义Userforms，正如 Jeeped 所暗示的那样。

Option Explicit

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 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

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

Public 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

Public Function BBmsgbox(mhwnd As Long, _
    mMsgbox As VbMsgBoxStyle, Title As String, _
    Prompt As String, Optional mMsgIcon As VbMsgBoxStyle, _
    Optional ButA As String, Optional ButB As String, _
    Optional ButC As String) As String

    Dim CustomText As Long

    mbFlags = mMsgbox
    mbFlags2 = mMsgIcon
    mTitle = Title
    mPrompt = Prompt
    But1 = ButA
    But2 = ButB
    But3 = ButC
    CustomText = MessageBoxH(mhwnd, GetDesktopWindow(), mbFlags Or mbFlags2)

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

Sub TestYNC()
    Const MY_YES As String = "Aye"
    Const MY_NO As String = "Nay"
    Dim DialogResult As String

    DialogResult = BBmsgbox(1, vbYesNo, "[Title here]", "[Prompt here]", vbInformation, MY_YES, MY_NO)

    Select Case DialogResult
        Case MY_YES: MsgBox MY_YES & " = vbYes"
        Case MY_NO: MsgBox MY_NO & " = vbNo"
    End Select
End Sub

Answer 2

谢谢你们的迅速回答。至少我没有为这个问题找到简单直接的解决方案而感到愚蠢。我用英语和法语工作50/50。过去，MS Office正确地拥有安装在不同计算机上的法语和英语版本的MS Office，但最近MS切换到基于Web的365，他们决定我的个人资料要求使用法语区域/语言设置。我只是在接近最终的调试运行期间发现了MsgBox是/否按钮blooper，并且由于在我的应用程序中有许多实例，所以我希望有一个简单的修复方法，而不是用UserForms替换我的所有MsgBox。祈祷MS有朝一日能提供一种简单的工具来编辑MsgBox按钮标题。

如何更改消息框中按钮的名称？

2 个答案: