Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Visual Basic Excel Messages Box

Tags:

excel

vba

Hi I want to ask if is it possible to have MsgBox without any buttons only with my message? Maybe is another way to display messages to user without using MsgBox?

like image 761
szymon bonecki Avatar asked Mar 24 '26 06:03

szymon bonecki


1 Answers

While it might sound simple, writing the code to accomplish this task is way beyond what a typical programmer could be expected to do.

Is it possible to have MsgBox without any buttons only with my message?

MsgBox doesn't give you an option to hide it. But we can bypass by subclassing the Excel application and the message box itself.

Is another way to display messages to user without using MsgBox?

Yes, you have two alternatives:

  1. Use a customized userform, or
  2. Subclassing as I have shown below.

Screenshot

A standard message box, displaying the text "Look Mommy, My button is missing!!!", but without any buttons.

Code

Paste this code in a module and run the procedure 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
like image 178
Siddharth Rout Avatar answered Mar 26 '26 21:03

Siddharth Rout



Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!