Page 3 of 3 FirstFirst 123
Results 21 to 23 of 23

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

  1. #21
    Board Regular Jaafar Tribak's Avatar
    Join Date
    Dec 2002
    Location
    Larache--Morocco
    Posts
    7,178
    Post Thanks / Like
    Mentioned
    30 Post(s)
    Tagged
    2 Thread(s)

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

    Ok - I see what you mean .

    Try this : in the (ThisWorkbook Module)
    Code:
    Option Explicit
    
    #If  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
    #Else 
        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
    #End  If
    
    Private WithEvents cmndbars As CommandBars
    Private cur As String
    
    
    Sub Test()
    
        On Error GoTo errHandler
    
        cur = ActiveSheet.Name
    
        EnableScreenUpdatingAPI = False
        
        Sheets("Print").Select
           
        Application.CommandBars.ExecuteMso "PrintPreviewAndPrint"
        
        Call Start_PrintPreviewAndPrint_CloseEventListener    
    
    
            'rest of your code here...    
    
    
        Exit Sub
        
    errHandler:
        EnableScreenUpdatingAPI = True
    
    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
            EnableScreenUpdatingAPI = True
            Set cmndbars = Nothing
            Debug.Print "done"
        End If
        
    End Sub
    
    
    Private Property Let EnableScreenUpdatingAPI(ByVal Enable As Boolean)
    
        #If  VBA7 Then
            Dim hwnd As LongPtr
        #Else 
            Dim hwnd As Long
        #End  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
    Office/Excel 2010 64Bits -- Win10 64Bits

    Common sense is not so common.


    http://photo-larache.blogspot.com/

  2. #22
    New Member
    Join Date
    Jun 2019
    Posts
    11
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

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

    Now after exiting print preview the sheet is "frozen"

  3. #23
    Board Regular Jaafar Tribak's Avatar
    Join Date
    Dec 2002
    Location
    Larache--Morocco
    Posts
    7,178
    Post Thanks / Like
    Mentioned
    30 Post(s)
    Tagged
    2 Thread(s)

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

    Quote Originally Posted by vanowm View Post
    Now after exiting print preview the sheet is "frozen"
    Doesn't freeze for me. I use excel 2016


    Try this variation :
    Code:
    Option Explicit
    
    #If  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
    #Else 
        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
    #End  If
    
    Private WithEvents cmndbars As CommandBars
    Private cur As String
    
    
    Sub Test2()
    
        On Error GoTo errHandler
    
        cur = ActiveSheet.Name
    
        EnableScreenUpdatingAPI = False
        
        Sheets("Print").Select
           
        Application.CommandBars.ExecuteMso "PrintPreviewAndPrint"
        
        Call Start_PrintPreviewAndPrint_CloseEventListener    
    
    
            'rest of your code here...
        
    
    
        Exit Sub
        
    errHandler:
        EnableScreenUpdatingAPI = True
    
    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
            EnableScreenUpdatingAPI = True
            Debug.Print "done"
        End If
        
    End Sub
    
    
    Private Property Let EnableScreenUpdatingAPI(ByVal Enable As Boolean)
    
        #If  VBA7 Then
            Dim hwnd As LongPtr
        #Else 
            Dim hwnd As Long
        #End  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&
        InvalidateRect hwnd, 0, 0
        
    End Property
    Office/Excel 2010 64Bits -- Win10 64Bits

    Common sense is not so common.


    http://photo-larache.blogspot.com/

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •