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