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