Open native (not Sheet.PrintPreview) print preview window for non-active sheet?

[vanowm]

Hello.

I'm trying open "native" print preview window (the same window that opens when clicked print button in toolbar) for a specific sheet.
The only command I know that can do this is

Application.CommandBars.ExecuteMso "PrintPreviewAndPrint"

But I'm having problem open it for a specific sheet and stay on original sheet when the window is closed:

cur = ActiveSheet.Name
Sheets("Print").Select
'ActiveSheet.PrintPreview 'shows correct sheet
Application.CommandBars.ExecuteMso "PrintPreviewAndPrint" 'shows incorrect sheet
Sheets(cur).Select

The problem with this code is that print preview loads active sheet AFTER the rest of the code was executed.
So maybe it needs some kind of a "preview window closed" event listener and then switch to "original" sheet?

Any suggestions?

Thank you.

 

[Jaafar Tribak]

Ok - I see what you mean .

Try this : in the (ThisWorkbook Module)

Option Explicit

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    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
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private WithEvents cmndbars As CommandBars
Private cur As String


Sub Test()

    On Error GoTo errHandler

    cur = ActiveSheet.Name

    [COLOR=#0000ff][B]EnableScreenUpdatingAPI = False[/B][/COLOR]
    
    Sheets("Print").Select
       
    Application.CommandBars.ExecuteMso "PrintPreviewAndPrint"
    
    Call Start_PrintPreviewAndPrint_CloseEventListener    


        [COLOR=#008000]'rest of your code here...[/COLOR]    


    Exit Sub
    
errHandler:
    [COLOR=#0000ff][B]EnableScreenUpdatingAPI = True[/B][/COLOR]

End Sub



Private Sub Start_PrintPreviewAndPrint_CloseEventListener()

    Set cmndbars = Application.CommandBars
    Call cmndbars_OnUpdate
    
End Sub


Private Sub cmndbars_OnUpdate()

    If FindWindowEx(Application.hwnd, 0, "FullpageUIHost", vbNullString) = 0 Then
        Sheets(cur).Select
        [B][COLOR=#0000ff]EnableScreenUpdatingAPI = True[/COLOR][/B]
        Set cmndbars = Nothing
        Debug.Print "done"
    End If
    
End Sub


Private Property Let EnableScreenUpdatingAPI(ByVal Enable As Boolean)

    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
        Dim hwnd As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Dim hwnd As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

    Const WM_SETREDRAW = &HB
    
    hwnd = FindWindowEx(FindWindowEx(Application.hwnd, 0, "XLDESK", vbNullString), 0, "EXCEL7", vbNullString)
    SendMessage hwnd, ByVal WM_SETREDRAW, ByVal CLng(Enable), 0&
    
End Property

 

[vanowm]

Now after exiting print preview the sheet is "frozen"

 

[Jaafar Tribak]

Now after exiting print preview the sheet is "frozen"

Doesn't freeze for me. I use excel 2016


Try this variation :

Option Explicit

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function InvalidateRect Lib "user32" (ByVal hwnd As LongPtr, ByVal lpRect As Long, ByVal bErase As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    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 InvalidateRect Lib "user32" (ByVal hwnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private WithEvents cmndbars As CommandBars
Private cur As String


Sub Test2()

    On Error GoTo errHandler

    cur = ActiveSheet.Name

    [B][COLOR=#0000ff]EnableScreenUpdatingAPI = False[/COLOR][/B]
    
    Sheets("Print").Select
       
    Application.CommandBars.ExecuteMso "PrintPreviewAndPrint"
    
    Call Start_PrintPreviewAndPrint_CloseEventListener    


        [COLOR=#008000]'rest of your code here...[/COLOR]
    


    Exit Sub
    
errHandler:
    [B][COLOR=#0000ff]EnableScreenUpdatingAPI = True[/COLOR][/B]

End Sub


Private Sub Start_PrintPreviewAndPrint_CloseEventListener()

    Set cmndbars = Application.CommandBars
    Call cmndbars_OnUpdate
    
End Sub


Private Sub cmndbars_OnUpdate()

    If FindWindowEx(Application.hwnd, 0, "FullpageUIHost", vbNullString) = 0 Then
        Sheets(cur).Select
        Set cmndbars = Nothing
        [B][COLOR=#0000ff]EnableScreenUpdatingAPI = True[/COLOR][/B]
        Debug.Print "done"
    End If
    
End Sub


Private Property Let EnableScreenUpdatingAPI(ByVal Enable As Boolean)

    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
        Dim hwnd As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Dim hwnd As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

    Const WM_SETREDRAW = &HB
    
    hwnd = FindWindowEx(FindWindowEx(Application.hwnd, 0, "XLDESK", vbNullString), 0, "EXCEL7", vbNullString)
    SendMessage hwnd, ByVal WM_SETREDRAW, ByVal CLng(Enable), 0&
    [COLOR=#0000ff][B]InvalidateRect hwnd, 0, 0[/B][/COLOR]
    
End Property