print dialog box

[momo007]

Hi all,

I'm wondering if there is a way to bypass the print dialog box... the box that shows "now printing page.... " with the cancel button.

Thanks

 

[Tom Urtis]

From Stratos Malasiotis, to bypass the "now printing page" dialog. This is a Windows setting, not an Excel setting, so API is required.


Option Explicit

Private Declare Function SendMessage _
Lib "user32" _
Alias "SendMessageA" _
( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any _
) _
As Long

Private Declare Function IsWindow _
Lib "user32" _
( _
ByVal hwnd As Long _
) _
As Long

Private Declare Function InvalidateRect _
Lib "user32" _
( _
ByVal hwnd As Long, _
lpRect As Long, _
ByVal bErase As Long _
) _
As Long

Private Declare Function UpdateWindow _
Lib "user32" _
( _
ByVal hwnd As Long _
) _
As Long

Private Declare Function GetDesktopWindow _
Lib "user32" () _
As Long

Public Function fncScreenUpdating _
( _
State As Boolean, _
Optional Window_hWnd As Long = 0 _
)

Const WM_SETREDRAW = &HB
Const WM_PAINT = &HF

If Window_hWnd = 0 Then
Window_hWnd = GetDesktopWindow()
Else
If IsWindow(hwnd:=Window_hWnd) = False Then
Exit Function
End If
End If

If State = True Then
Call SendMessage _
( _
hwnd:=Window_hWnd, _
wMsg:=WM_SETREDRAW, _
wParam:=1, _
lParam:=0 _
)
Call InvalidateRect _
( _
hwnd:=Window_hWnd, _
lpRect:=0, _
bErase:=True _
)
Call UpdateWindow(hwnd:=Window_hWnd)
Else
Call SendMessage _
( _
hwnd:=Window_hWnd, _
wMsg:=WM_SETREDRAW, _
wParam:=0, _
lParam:=0 _
)
End If

End Function

Sub PrintDirect()
fncScreenUpdating State:=False
ActiveSheet.PrintOut
fncScreenUpdating State:=True
End Sub

 

[momo007]

Hi Tom,

Could you please explain how I can use your code... do i just copy that into my Excel macro?

Thanks.

 

[Tom Urtis]

Place the code I posted in a standard VBA module.

The "print" part of the code is this macro:

Sub PrintDirect()
fncScreenUpdating State:=False
ActiveSheet.PrintOut
fncScreenUpdating State:=True
End Sub


That PrintDirect macro was for illustrative purposes to show you an example of how to use the API calls, because you asked how to bypass the print dialog box.

Substitute the example codeline
ActiveSheet.PrintOut
by placing the print-related code in your current code between the lines
fncScreenUpdating State:=False
and
fncScreenUpdating State:=True
as the example macro suggests.

 

[joelabine]

This solution works fine.
But what can be done if the selected printer prints to a file? (EG. Adobe PDF printer)
The "save as" dialog box won't be draw. All the system will looks frozen.

Is there something that can be done for that?

Thanks

 

[djreiswig]

Sorry to bring up such an old thread, but when I try this code in Excel 2003 under Vista Home Premium the box still flashes on the screen. It doesn't have any text or buttons on it, but the outline is still there. How can I make it go away completely? I am calling it from a userform with a progressbar on it, so maybe that has something to do with it?

 

[Jaafar Tribak]

Upon the request of a fellow member, i've written this code which hides the Now Printing window but ovecomes the screen freezing problem.

Caller code : (WARNING !! - try this on a new worksheet with 1 page to print only so as not to end up with endless printouts !! )

Sub PrintTest()

    Dim i As Long
    
    For i = 1 To 10
        Hide_NowPrinting_Window = True
        ActiveSheet.PrintOut
        [B][COLOR=Green]'notice how the range updates ( no screen freezing )[/COLOR][/B]
        Range("a1") = Range("a1") + 1
    Next i

End Sub

Main code in a Standard module :

Option Explicit

Private Declare Function FindWindow Lib "user32.dll" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
 
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal lNewLong 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 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 CallNextHookEx Lib "user32" _
(ByVal hHook As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
 
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
 
Private Declare Function GetCurrentThreadId Lib "kernel32" _
() As Long
 
Private Declare Function GetClassName Lib "user32.dll" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
 
Private Declare Function EnableWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal fEnable As Long) As Long

Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
 
Private Declare Function RegisterHotKey Lib "user32" _
(ByVal hwnd As Long, _
ByVal id As Long, _
ByVal fsModifiers As Long, _
ByVal vk As Long) As Long
 
Private Declare Function UnregisterHotKey Lib "user32" _
(ByVal hwnd As Long, _
ByVal id As Long) As Long

Private Const WH_CBT As Long = 5
Private Const GWL_HINSTANCE As Long = (-6)
Private Const HCBT_CREATEWND = 3
Private Const GWL_WNDPROC As Long = (-4)
Private Const WM_DESTROY As Long = &H2
Private Const WM_NCPAINT As Long = &H85

Private Const NOW_PRINTING_WND_CLASS_NAME As String = "bosa_sdm_XL9"
Private lCBTHook  As Long
Private lPrevWnProc As Long
Private lESCkey As Long
Private bCurrentlyPrinting As Boolean



Public Property Let Hide_NowPrinting_Window(Hidden As Boolean)

    'make sure there is somthing to print
    'to avoid raising an error while the hook is set.
    If WorksheetFunction.CountA(ActiveSheet.UsedRange) <> 0 Then
         If Hidden And Not bCurrentlyPrinting Then
            bCurrentlyPrinting = True
            'Temporarly disable the ESC key .
            lESCkey = 1
            Call RegisterHotKey(0&, lESCkey, 0&, vbKeyEscape)
            'Temporarly hook the excel process to watch
            'for the 'Now Printing' Window.
            lCBTHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, _
            GetAppInstance, GetCurrentThreadId)
        End If
    End If

End Property



Private Function CBTProc _
(ByVal idHook As Long, ByVal wParam As Long, _
 ByVal lParam As Long) As Long
 
    Dim sBuffer As String
    Dim lRetVal As Long
 
    Select Case idHook
    
        Case Is = HCBT_CREATEWND
        ' Some Wnd has been created within the excel process.
        sBuffer = Space(256)
        lRetVal = GetClassName(wParam, sBuffer, 256)
          'Is it our 'Now Printing' wnd ?
        If Left(sBuffer, lRetVal) = NOW_PRINTING_WND_CLASS_NAME Then
        'if so subclass it now.
        lPrevWnProc = SetWindowLong _
        (wParam, GWL_WNDPROC, AddressOf CallBack)
        End If
        
        'done with hook.
        UnhookWindowsHookEx lCBTHook
    
    End Select
    
    'Call next hook if any.
    CBTProc = CallNextHookEx _
    (lCBTHook, idHook, ByVal wParam, ByVal lParam)
 
End Function
 
 

Private Function CallBack _
(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
 
    Select Case Msg
    
        Case WM_NCPAINT
            'If the 'Now Printing' Wnd is being redrawn
            'Disable it and hide it.
            EnableWindow hwnd, 0
            ShowWindow hwnd, 0
     
        Case WM_DESTROY
        
            'The Printing finishes here
            'so unsubclass the wnd and restore the ESC key.
            Call UnregisterHotKey(0, lESCkey)
            Call SetWindowLong(hwnd, GWL_WNDPROC, lPrevWnProc)
            bCurrentlyPrinting = False
           
   End Select
    
    CallBack = CallWindowProc _
    (lPrevWnProc, hwnd, Msg, wParam, ByVal lParam)
 
End Function


Private Function GetAppInstance() As Long
 
    GetAppInstance = GetWindowLong _
    (FindWindow("XLMAIN", Application.Caption), GWL_HINSTANCE)
 
End Function

Tested and working well on excel 2007 Win 7 Only. Not sure if it works under different versions.

 

[jerem]

From Stratos Malasiotis, to bypass the "now printing page" dialog. This is a Windows setting, not an Excel setting, so API is required.


Option Explicit

Private Declare Function SendMessage _
Lib "user32" _
Alias "SendMessageA" _
( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any _
) _
As Long

Private Declare Function IsWindow _
Lib "user32" _
( _
ByVal hwnd As Long _
) _
As Long

Private Declare Function InvalidateRect _
Lib "user32" _
( _
ByVal hwnd As Long, _
lpRect As Long, _
ByVal bErase As Long _
) _
As Long

Private Declare Function UpdateWindow _
Lib "user32" _
( _
ByVal hwnd As Long _
) _
As Long

Private Declare Function GetDesktopWindow _
Lib "user32" () _
As Long

Public Function fncScreenUpdating _
( _
State As Boolean, _
Optional Window_hWnd As Long = 0 _
)

Const WM_SETREDRAW = &HB
Const WM_PAINT = &HF

If Window_hWnd = 0 Then
Window_hWnd = GetDesktopWindow()
Else
If IsWindow(hwnd:=Window_hWnd) = False Then
Exit Function
End If
End If

If State = True Then
Call SendMessage _
( _
hwnd:=Window_hWnd, _
wMsg:=WM_SETREDRAW, _
wParam:=1, _
lParam:=0 _
)
Call InvalidateRect _
( _
hwnd:=Window_hWnd, _
lpRect:=0, _
bErase:=True _
)
Call UpdateWindow(hwnd:=Window_hWnd)
Else
Call SendMessage _
( _
hwnd:=Window_hWnd, _
wMsg:=WM_SETREDRAW, _
wParam:=0, _
lParam:=0 _
)
End If

End Function

Sub PrintDirect()
fncScreenUpdating State:=False
ActiveSheet.PrintOut
fncScreenUpdating State:=True
End Sub

Hi Tom,

I have tried your code with a Ms Access application. It works great until Windows 7. When running on Windows 10, it seems that the code manages to hide the message in the dialog box but not the dialog box itself. Would you be able to post an update or to explain what needs to be changed for this to work in Windows 10? Thank you!
Jerem

PS: Sorry for reviving a thread that is almost 15 years old...

 

[Tom Urtis]

It's probably a 64-bit API declaration issue. Regarding (and relating to) your PS comment, no problem at all, in fact it's great that you posted on this older thread. The thing is, back in 2004 when this thread started, systems were predominantly 32-bit. Fast forward to 2018 and it's just the opposite -- 64 bit systems are the norm. As such, API calls relying on 32-bit platforms can fail, which I suspect is the case here. Take a look at Jan Karel's page on his website regarding API function declarations in 64-bit Office, with how these declarations can be modified:
https://www.jkp-ads.com/articles/apideclarations.asp