PreviewReport Function

This custom function is the simplest and safest way to preview reports in any Microsoft Access application.

PreviewReport Function

There are several things that annoy me about the default behavior of DoCmd.OpenReport.  To address these annoyances, I built a replacement function that I named PreviewReport().

In this series of articles, I went through the evolution of this function as I addressed each of my frustrations with DoCmd.OpenReport:

  1. Auto-Print: Opening a report sends it directly to the printer with no on-screen preview
  2. Wrong Data: If you call OpenReport on a report that's already open, Access doesn't apply the new criteria to the report
  3. Unwarranted Errors: When you cancel report opening in the OnNoData event, Access raises an error
  4. Cascading Maximize: If you open a report from a windowed form, maximize the report, then close it, the windowed form from which you opened the report gets maximized
  5. Missing OpenArgs: Prior to Access 2007, OpenArgs was not supported for the OpenReport method

The Code

Without further ado, here is the finished product.  

Note: In Part 3 of the series, I mentioned that the version of the PreviewReport function that I use within my own applications relies on a global vbWatchdog error handler.  The version I'm presenting here does not require vbWatchdog.  The vbWatchdog-only version--which I decided not to include--is nearly identical to the code shown here, except that it omits the "On Error Goto" line and the final block of mostly boilerplate error-handling code.  The code below will work perfectly fine with or without vbWatchdog.
'---------------------------------------------------------------------------------------
' Procedure : PreviewReport (vbWatchdog optional)
' Author    : Mike Wolfe (https://nolongerset.com/previewreport-function/)
' Purpose   : Opens a report in preview mode, optionally applying a Where condition.
' Notes     - Returns False if report did not open (likely due to a NoData cancel event)
'           - Closes existing report if currently open so that proper filter is applied
'           - Adjusts size of report to fill available Access client window but without
'               actually maximizing the report; workaround for hard crash in Access 2007
'               (see: https://stackoverflow.com/q/24460881/154439)
'           - Supports the OpenArgs parameter introduced in Access 2007
'               without breaking compile on earlier versions
'           - Requires a vbWatchdog global error handler that applies
'               On Error Resume Next handling to every instance of error 2501
'---------------------------------------------------------------------------------------
'
Function PreviewReport(RptName As String, _
                       Optional Where As String = "", _
                       Optional OpenArgs As String = "") As Boolean
    On Error GoTo Err_PreviewReport
    
    'Avoid "Syntax error (missing operator) in query expression" errors
    If Right$(Trim$(Where), 1) = "=" Then Exit Function
    
    Dim IsMaxed As Boolean, ActiveHwnd As Long
    ActiveHwnd = ActiveObjectHwnd
    If ActiveHwnd <> 0 Then
        IsMaxed = IsMaximized(ActiveHwnd)
    Else
        IsMaxed = False
    End If
    If ReportIsOpen(RptName) Then DoCmd.Close acReport, RptName
    
    'OpenArgs for reports was added in Access 2007
    If CSng(SysCmd(acSysCmdAccessVer)) >= 12 And Len(OpenArgs) > 0 Then
        'Workaround to allow code to compile in versions of Access prior to Access 2007
        Dim AccessApp As Object
        Set AccessApp = Application
        AccessApp.DoCmd.OpenReport RptName, acViewPreview, , Where, , OpenArgs
    Else
        DoCmd.OpenReport RptName, acViewPreview, , Where
    End If
    
    'No error was raised; the report must have opened successfully
    PreviewReport = True
    
    If Not IsMaxed Then
        FillAccessWindow Reports(RptName).hWnd
        'We call it a second time because the first call may
        '  add scroll bars/status bars that need to be accounted for
        DoEvents
        FillAccessWindow Reports(RptName).hWnd
    End If
    
Exit_PreviewReport:
    Exit Function
Err_PreviewReport:
    Select Case Err.Number
    Case 2501   'The OpenReport action was canceled.
        PreviewReport = False
    Case Else
        MsgBox Err.Description, vbExclamation, "Error: " & Err.Number
    End Select
    Resume Exit_PreviewReport
End Function

Prerequisite code

The PreviewReport function listed above calls several other functions that I've previously published, including:

For convenience, I've reproduced the required code below for easy copy-and-pasting into your applications:

'--== Prerequisites for the PreviewReport() function ==--
Private Type rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

#If VBA7 Then
    Private Declare PtrSafe Function apiMoveWindow Lib "user32" Alias "MoveWindow" (ByVal hWnd As LongPtr, _
                                                                        ByVal X As Long, ByVal Y As Long, _
                                                                        ByVal nWidth As Long, ByVal nHeight As Long, _
                                                                        ByVal bRepaint As Long) As Long
#Else
    Private Declare Function apiMoveWindow Lib "user32" Alias "MoveWindow" (ByVal hWnd As Long, _
                                                                        ByVal x As Long, ByVal y As Long, _
                                                                        ByVal nWidth As Long, ByVal nHeight As Long, _
                                                                        ByVal bRepaint As Long) As Long
#End If

#If VBA7 Then
    Private Declare PtrSafe Function apiGetClientRect Lib "user32" Alias "GetClientRect" (ByVal hWnd As LongPtr, lpRect As rect) As Long
#Else
    Private Declare Function apiGetClientRect Lib "user32" Alias "GetClientRect" (ByVal hWnd As Long, lpRect As rect) As Long
#End If

#If VBA7 Then
    Private Declare PtrSafe Function apiFindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, _
                                                                            ByVal hWnd2 As LongPtr, _
                                                                            ByVal lpsz1 As String, _
                                                                            ByVal lpsz2 As String) As LongPtr
#Else
    Private Declare Function apiFindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, _
                                                                             ByVal hWnd2 As Long, _
                                                                             ByVal lpsz1 As String, _
                                                                             ByVal lpsz2 As String) As Long
#End If

#If VBA7 Then
    Private Declare PtrSafe Function apiGetParent Lib "user32" _
        Alias "GetParent" _
        (ByVal hWnd As LongPtr) _
        As LongPtr
#Else
    Private Declare Function apiGetParent Lib "user32" _
        Alias "GetParent" _
        (ByVal hWnd As Long) _
        As Long
#End If

'Functions return 1 for true and 0 for false; multiply result by -1 for safer Boolean use
#If VBA7 Then
    Private Declare PtrSafe Function IsZoomed Lib "user32" (ByVal hWnd As LongPtr) As Integer
#Else
    Private Declare Function IsZoomed Lib "user32" (ByVal hWnd As Long) As Integer
#End If

'----------------------------------------------------
' Procedure : FillAccessWindow
' Author    : Mike Wolfe <mike@nolongerset.com>
' Source    : https://nolongerset.com/fun-with-form-windows/
'
'Used to set the window size of an Access form or report
'Usage A: Fill the available screen space
'   FillAccessWindow Frm.Hwnd
'
'Usage B: Maximize the form or report while maintaining a given ratio (a square in this example)
'   FillAccessWindow Frm.Hwnd, 1
'
'Usage C: A tall window anchored to the upper right corner of available space
'   FillAccessWindow Frm.Hwnd, 2.5, "NE"
'
'Usage D: Arrange four forms to fill the corners of the available space
'   FillAccessWindow FrmA.Hwnd, , "NW", 0.5, 0.5
'   FillAccessWindow FrmB.Hwnd, , "NE", 0.5, 0.5
'   FillAccessWindow FrmC.Hwnd, , "SE", 0.5, 0.5
'   FillAccessWindow FrmD.Hwnd, , "SW", 0.5, 0.5
'
Sub FillAccessWindow(Optional ChildHWnd As Long, _
    Optional HtToWdRatio As Double = 0, _
    Optional AnchorLoc As String = "NW", _
    Optional HeightToCanvasRatio As Double = 1, _
    Optional WidthToCanvasRatio As Double = 1)

    
    Dim hWnd As Long, Canvas As rect
    hWnd = GetHWnd(ChildHWnd)
    Canvas = GetCanvas(hWnd)
    
    Dim wd As Long, ht As Long
    wd = (Canvas.Right - Canvas.Left) * WidthToCanvasRatio
    ht = (Canvas.Bottom - Canvas.Top) * HeightToCanvasRatio
   
   'Handle the case where we want to maintain a specific Height-to-Width ratio
    If HtToWdRatio <> 0 Then
        Dim CanvasHtToWdRatio As Double
        CanvasHtToWdRatio = (Canvas.Bottom - Canvas.Top) / (Canvas.Right - Canvas.Left)
        If CanvasHtToWdRatio > HtToWdRatio Then
            ht = wd * HtToWdRatio
        Else
            wd = ht / HtToWdRatio
        End If
    End If

    'Move and resize the window
    Select Case AnchorLoc
        Case "Center"
            apiMoveWindow hWnd, (Canvas.Right - wd) / 2, (Canvas.Bottom - ht) / 2, wd, ht, True
        Case "NE"
            apiMoveWindow hWnd, Canvas.Right - wd, 0, wd, ht, True
        Case "SE"
            apiMoveWindow hWnd, Canvas.Right - wd, Canvas.Bottom - ht, wd, ht, True
        Case "SW"
            apiMoveWindow hWnd, 0, Canvas.Bottom - ht, wd, ht, True
        Case Else '"NW"
            apiMoveWindow hWnd, 0, 0, wd, ht, True
    End Select
End Sub

'Returns HWnd if <> 0, else the window handle of the active on-screen object
Private Function GetHWnd(hWnd As Long) As Long
    On Error Resume Next
    GetHWnd = hWnd
    If GetHWnd = 0 Then GetHWnd = Screen.ActiveForm.hWnd
    If GetHWnd = 0 Then GetHWnd = Screen.ActiveReport.hWnd
    If GetHWnd = 0 Then GetHWnd = Screen.ActiveDatasheet.hWnd
End Function

Function GetCanvas(Optional ByVal ChildHWnd As Long) As rect
    Dim CanvasHwnd As Long
    CanvasHwnd = GetInnerAccessHwnd(ChildHWnd)
    apiGetClientRect CanvasHwnd, GetCanvas
End Function

'---------------------------------------------------------------------------------------
' Procedure : GetInnerAccessHwnd
' Author    : Mike Wolfe
' Date      : 11/26/2014
' Purpose   : Gets the window handle of the Access "canvas".
' Notes     - We don't use HWndAccessApp here because that's the window handle for the
'               full application; what we really want is the handle for the "inner container";
'               ie, the Access window minus the docked menus, docked toolbars, and status bar
'---------------------------------------------------------------------------------------
'
Function GetInnerAccessHwnd(Optional ByVal ChildHWnd As Long = 0) As Variant 'Variant used instead of Conditional Compile (Long needed for 32bit LongPtr needed for 64bit)
    
    GetInnerAccessHwnd = apiFindWindowEx(hWndAccessApp, ByVal 0&, "MDIClient", vbNullString)
    If GetInnerAccessHwnd <> 0 Then Exit Function

    On Error Resume Next
    If ChildHWnd = 0 Then ChildHWnd = Screen.ActiveForm.hWnd
    If ChildHWnd = 0 Then ChildHWnd = Screen.ActiveReport.hWnd
    If ChildHWnd = 0 Then ChildHWnd = Screen.ActiveDatasheet.hWnd
    GetInnerAccessHwnd = apiGetParent(ChildHWnd)
End Function

'source: https://nolongerset.com/get-a-handle-on-window-state/
Function IsMaximized(hWnd As Long) As Boolean
    IsMaximized = IsZoomed(hWnd) * -1
End Function

'source: https://nolongerset.com/why-so-lazy-access/
Function ReportIsOpen(RptName As String) As Boolean
    ReportIsOpen = (SysCmd(acSysCmdGetObjectState, acReport, RptName) <> 0)
End Function

'source: https://nolongerset.com/avoid-the-cascading-maximize/
Function ActiveObjectHwnd() As Long
    On Error Resume Next
    ActiveObjectHwnd = Screen.ActiveForm.hWnd
    If ActiveObjectHwnd <> 0 Then Exit Function
    ActiveObjectHwnd = Screen.ActiveReport.hWnd
    If ActiveObjectHwnd <> 0 Then Exit Function
    ActiveObjectHwnd = Screen.ActiveDatasheet.hWnd
End Function

Image by mohamed Hassan from Pixabay

Comments

Sign in or become a No Longer Set member to join the conversation.
Just enter your email below to get a log in link. (This will also subscribe you to my weekly newsletter.)