VBA & Unbound Report (1 Viewer)

Option Compare Database   'Use database order for string comparisons.
Option Explicit

'  Constant for maximum number of columns qryAgencyByMonthCentralCrosstab query would
'  create plus 1 for a Totals column.
Const conTotalColumns = 11

'  Variables for Database object and Recordset.
Dim dbsReport As Database
Dim rstReport As Recordset

'  Variables for number of columns and row and report totals.
Dim intColumnCount As Integer
Dim lngRgColumnTotal(1 To conTotalColumns) As Long
Dim lngReportTotal As Long

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
 '  Place values in text boxes and hide unused text boxes.
    
    Dim intX As Integer
    '  Verify that not at end of recordset.
    If Not rstReport.EOF Then
        '  If FormatCount is 1, place values from recordset into text boxes
        '  in detail section.
        If Me.FormatCount = 1 Then
            For intX = 1 To intColumnCount
                '  Convert Null values to 0.
                Me("Col" + Format(intX)) = xtabCnulls(rstReport(intX - 1))
            Next intX
    
            '  Hide unused text boxes in detail section.
            For intX = intColumnCount + 2 To conTotalColumns
                Me("Col" + Format(intX)).Visible = False
            Next intX

            '  Move to next record in recordset.
            rstReport.MoveNext
        End If
    End If
   
    
End Sub

Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)
    
    Dim intX As Integer
    Dim lngRowTotal As Long

    '  If PrintCount is 1, initialize rowTotal variable.
    '  Add to column totals.
    If Me.PrintCount = 1 Then
        lngRowTotal = 0
        
        For intX = 2 To intColumnCount
            '  Starting at column 2 (first text box with crosstab value),
            '  compute total for current row in detail section.
            lngRowTotal = lngRowTotal + Me("Col" + Format(intX))
            '  Add crosstab value to total for current column.
            lngRgColumnTotal(intX) = lngRgColumnTotal(intX) + Me("Col" + Format(intX))
        Next intX
        
        '  Place row total in text box in detail section.
        Me("Col" + Format(intColumnCount + 1)) = lngRowTotal
        '  Add row total for current row to grand total.
        lngReportTotal = lngReportTotal + lngRowTotal
    End If
    
    Me.Section("Detail").AlternateBackColor = RGB(255, 255, 255)
    
End Sub

Private Sub Detail_Retreat()

    ' Always back up to previous record when detail section retreats.
    rstReport.MovePrevious

End Sub

Private Sub InitVars()
    
    Dim intX As Integer

    ' Initialize lngReportTotal variable.
    lngReportTotal = 0
    
    ' Initialize array that stores column totals.
    For intX = 1 To conTotalColumns
        lngRgColumnTotal(intX) = 0
    Next intX

End Sub

Private Sub PageHeaderSection_Format(Cancel As Integer, FormatCount As Integer)
    
    Dim intX As Integer
    
    '  Put column headings into text boxes in page header.
    For intX = 1 To intColumnCount
        Me("Head" + Format(intX)) = rstReport(intX - 1).Name
    Next intX

    '  Make next available text box Totals heading.
    Me("Head" + Format(intColumnCount + 1)) = "TOTAL"

    '  Hide unused text boxes in page header.
    For intX = (intColumnCount + 2) To conTotalColumns
        Me("Head" + Format(intX)).Visible = False
    Next intX
End Sub

Private Sub Report_Close()
    
    On Error Resume Next

    '  Close recordset.
    rstReport.Close
    
End Sub


Private Sub Report_NoData(Cancel As Integer)
    MsgBox "No records match the criteria you entered.", vbExclamation, "No Records Found"
    rstReport.Close
    Cancel = True
End Sub

Private Sub Report_Open(Cancel As Integer)

    '  Create underlying recordset for report using criteria entered in
    '  MARReferralAgencies form.
    
    Dim intX As Integer
    Dim qdf As QueryDef
    Dim frm As Form
            
   
    '  Set database variable to current database.
    Set dbsReport = CurrentDb
    Set frm = Forms!MARReferralAgencies
    
    
    
    '  Open QueryDef object.
   '   Set qdf = dbsReport.QueryDefs("rptAgencyByMonthCentral")
    
      Set qdf = dbsReport.QueryDefs(Me.RecordSource)
    
    
    ' Set parameters for query based on values entered
    ' in MARReferralAgencies form.
    qdf.Parameters("Forms!MARReferralAgencies!YEARCENTRALYEARMONTH") _
        = frm!YEARCENTRALYEARMONTH
    qdf.Parameters("Forms!MARReferralAgencies!YEARCENTRALMONTH") _
        = frm!YEARCENTRALMONTH

    '  Open Recordset object.
    Set rstReport = qdf.OpenRecordset()
    
    '  Set a variable to hold number of columns in crosstab query.
    intColumnCount = rstReport.Fields.Count
    
    

End Sub

Private Sub ReportFooter_Print(Cancel As Integer, PrintCount As Integer)
    
    Dim intX As Integer

    '  Place column totals in text boxes in report footer.
    '  Start at column 2 (first text box with crosstab value).
    For intX = 2 To intColumnCount
        Me("Tot" + Format(intX)) = lngRgColumnTotal(intX)
    Next intX

    '  Place grand total in text box in report footer.
    Me("Tot" + Format(intColumnCount + 1)) = lngReportTotal

    '  Hide unused text boxes in report footer.
    For intX = intColumnCount + 2 To conTotalColumns
        Me("Tot" + Format(intX)).Visible = False
    Next intX
End Sub

Private Sub ReportHeader_Format(Cancel As Integer, FormatCount As Integer)

    '  Move to first record in recordset at beginning of report
    '  or when report is restarted. (A report is restarted when
    '  you print a report from Print Preview window, or when you return
    '  to a previous page while previewing.)
    rstReport.MoveFirst

    'Initialize variables.
    InitVars

End Sub
Private Function xtabCnulls(varX As Variant)

    ' Test if a value is null.
    If IsNull(varX) Then
        ' If varX is null, set varX to 0.
        xtabCnulls = 0
    Else
        ' Otherwise, return varX.
        xtabCnulls = varX
    End If

End Function