Visual Basic Excel消息框

Question

嗨,我想问一下是否可以在没有任何按钮的情况下使用MsgBox和我的消息？也许是在不使用MsgBox的情况下向用户显示消息的另一种方法？

Answer 1

我通常不回答没有展示足够研究的问题,但这超出了普通用户的范围.

只有我的消息可以让MsgBox没有任何按钮吗？

Msgbox没有给你一个隐藏它的选项.但我们可以通过继承Excel应用程序和消息框来绕过.

在不使用MsgBox的情况下向用户显示消息的另一种方法是什么？

是的,你有两种选择

1. 使用自定义的用户表单或
2. 子类化,如下所示

截图

码

将此代码粘贴到模块中并运行该过程 Sample

Option Explicit

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, lparam As Any) As Long

Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
ByVal lpszClass As String, ByVal lpszCaption As String) As Long

Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Private Declare Function EnableWindow Lib "user32" _
(ByVal hwnd As Long, ByVal fEnable As Long) 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 SetWindowLong Lib "user32" _
Alias "SetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Declare Function CallWindowProc Lib "user32" _
Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, ByVal MSG As Long, ByVal WParam As Long, _
ByVal lparam As Long) As Long

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Private hwndXLApp As Long
Private hwndMsgBox As Long
Private hwndMsgBoxBtn As Long
Private HookIt As Long
Private OldAppWinProc As Long
Private OldMBoxWinProc As Long

Private Const WH_CBT As Long = 5
Private Const HCBT_CREATEWND As Long = 3
Private Const GWL_STYLE As Long = -16
Private Const DS_NOIDLEMSG As Long = &H100&
Private Const GWL_WNDPROC As Long = (-4)
Private Const WM_ENTERIDLE As Long = &H121
Private Const WM_COMMAND As Long = &H111
Private Const WM_NCDESTROY As Long = &H82

Sub Sample()
    hwndXLApp = FindWindow("XLMAIN", Application.Caption)

    '~> Setup the hook to catch creation of messagebox
    HookIt = SetWindowsHookEx(WH_CBT, AddressOf HookProc, 0, GetCurrentThreadId)

    MsgBox ("Look Mommy, My button is missing!!!")
End Sub

Private Function HookProc(ByVal idHook As Long, ByVal WParam As Long, ByVal lparam As Long) As Long
    Dim strBuffer As String
    Dim RetVal As Long, curStyle As Long, NewStyle As Long

    '~~> Check if a window is being created
    If idHook = HCBT_CREATEWND Then
        strBuffer = Space(256)

        '~~> Check if it is a MSGBOX
        RetVal = GetClassName(WParam, strBuffer, 256)
        If Left(strBuffer, RetVal) = "#32770" Then

            '~~> Handle of Msgbox
            hwndMsgBox = WParam

            '~~> We make the Msgbox Modeless so that we can use
            '~~> ShowWindow API to hide the button
            curStyle = GetWindowLong(WParam, GWL_STYLE)
            NewStyle = curStyle And Not DS_NOIDLEMSG
            SetWindowLong WParam, GWL_STYLE, NewStyle

            '~~> Subclass Excel app to catch the WM_ENTERIDLE message and
            OldAppWinProc = SetWindowLong(hwndXLApp, GWL_WNDPROC, AddressOf NewAppWindowProc)

            '~~> Sub class the msgbox to catch the WM_NCDESTROY message to cleanup
            OldMBoxWinProc = SetWindowLong(WParam, GWL_WNDPROC, AddressOf NewMsgBxWindowProc)

            '~~> UnHook
            UnhookWindowsHookEx HookIt
        End If
    End If

    '~~> Call next hook
    HookProc = CallNextHookEx(HookIt, idHook, ByVal WParam, ByVal lparam)
End Function

Private Function NewAppWindowProc(ByVal hwnd As Long, ByVal MSG _
As Long, ByVal WParam As Long, ByVal lparam As Long) As Long
    On Error Resume Next
    Select Case MSG
        Case WM_ENTERIDLE
            EnableWindow hwnd, 1
            hwndMsgBoxBtn = FindWindowEx(hwndMsgBox, ByVal 0&, "Button", vbNullString)
            ShowWindow hwndMsgBoxBtn, 0

            '~~> Un SubClass Excel
            SetWindowLong hwnd, GWL_WNDPROC, OldAppWinProc
    End Select

    '~~> Pass Intercepted Messages To The Original WinProc
    NewAppWindowProc = CallWindowProc(OldAppWinProc, hwnd, MSG, WParam, lparam)
End Function

Private Function NewMsgBxWindowProc(ByVal hwnd As Long, ByVal MSG _
As Long, ByVal WParam As Long, ByVal lparam As Long) As Long
    On Error Resume Next
    Select Case MSG
    Case WM_NCDESTROY, WM_COMMAND
        SetWindowLong hwnd, GWL_WNDPROC, OldMBoxWinProc
    End Select

    NewMsgBxWindowProc = CallWindowProc(OldMBoxWinProc, hwnd, MSG, WParam, lparam)
End Function