P
Paul
I have a report based on a crosstab query and the report is set to accept
up to 11 columns of column headings in the report. If the number of column
headings is greater than 11 the report will not display and the a error
message shows up. The first 3 column headings are the "row heading" in the
crosstab query and the remaining 8 columns in the report is for the "column
heading" in the query. I wonder if it is possible to instruct the system to
go to a new page when the "column heading" created in the crosstab query is
greater than 8. So that in the second page it will have the first 3 columns
plus the 9th column and onward in the query. Thanks.
The following is the code to create the report using the crosstab query.
Option Compare Database 'Use database order for string comparisons
Option Explicit
' Constant for maximum number of columns Pull Sheet query would
' create plus 1 for a Totals column.
Const TOTCOLS = 11
' Variables for database object and recordset.
Dim RptDB As Database
Dim RptRS As Recordset
' Variables for number of columns and row and report totals.
Dim IColCnt As Integer
Dim RgColTot(1 To TOTCOLS) As Long
Dim RptTotal As Long
Private Sub Detail1_Format(Cancel As Integer, FormatCount As Integer)
' Place values in text boxes and hide unused text boxes.
'
Dim i As Integer
' Verify that not at end of recordset.
If Not RptRS.EOF Then
' If FormatCount is 1, place values from recordsSet into text boxes
' in detail section.
If Me.FormatCount = 1 Then
For i = 1 To IColCnt
' Convert null values to 0.
Me("Col" + Format$(i)) = xtabCnulls(RptRS(i - 1))
Next i
' Hide unused text boxes in detail section.
For i = IColCnt + 2 To TOTCOLS
Me("Col" + Format$(i)).Visible = False
Next i
' Move to next record in recordset.
RptRS.MoveNext
End If
End If
End Sub
Private Sub Detail1_Retreat()
' Always back up to previous record when detail section retreats.
RptRS.MovePrevious
End Sub
Private Sub InitVars()
Dim i As Integer
' Initialize RptTotal variable.
RptTotal = 0
' Initialize array that stores column totals.
For i = 1 To TOTCOLS
RgColTot(i) = 0
Next i
End Sub
Private Sub PageHeader0_Format(Cancel As Integer, FormatCount As Integer)
Dim i As Integer
' Put column headings into text boxes in page header.
For i = 1 To IColCnt
Me("Head" + Format$(i)) = RptRS(i - 1).Name
Next i
' Hide unused text boxes in page header.
For i = (IColCnt + 2) To TOTCOLS
Me("Head" + Format$(i)).Visible = False
Next i
End Sub
Private Sub Report_Close()
DoCmd.Minimize
End Sub
Private Sub Report_Open(Cancel As Integer)
DoCmd.Maximize
' Create underlying recordset for report using criteria entered in
' Outcome Measure form.
'
Dim i As Integer
Dim MyQuery As QueryDef
' Don't open report if Outcome Measure form isn't loaded.
If Not (IsLoaded("Pull Sheet")) Then
Cancel = True
MsgBox "To preview or print this report, you must open the Packing
Slip in Form view.", 48, "Must Open Dialog Box"
Exit Sub
End If
' Set database variable to current database.
Set RptDB = DBEngine.Workspaces(0).Databases(0)
' Open QueryDef.
Set MyQuery = RptDB.QueryDefs("Qry_Host Purchase Order Pull Sheet")
' Set parameters for query based on values entered in Packing Slip
form.
MyQuery.Parameters("[Forms]![Pull Sheet]![Child23].[Form]![Host Purchase
Order]") = [Forms]![Pull Sheet]![Child23].[Form]![Host Purchase Order]
' Open Recordset.
Set RptRS = MyQuery.OpenRecordset()
' If no records match criteria, display message,
' close recordset, and cancel Open event.
If RptRS.RecordCount = 0 Then
MsgBox "No records match the criteria you entered.", 48, "No Records
Found"
RptRS.Close
Cancel = True
Exit Sub
End If
' Set a variable to hold number of columns in crosstab query.
IColCnt = RptRS.Fields.Count
End Sub
Private Sub ReportHeader3_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.)
RptRS.MoveFirst
'Initialize variables.
InitVars
End Sub
Private Function xtabCnulls(MyVal As Variant)
' Test if a value is null.
If IsNull(MyVal) Then
' If MyVal is null, set MyVal to 0.
xtabCnulls = 0
Else
' Otherwise, return MyVal.
xtabCnulls = MyVal
End If
End Function
up to 11 columns of column headings in the report. If the number of column
headings is greater than 11 the report will not display and the a error
message shows up. The first 3 column headings are the "row heading" in the
crosstab query and the remaining 8 columns in the report is for the "column
heading" in the query. I wonder if it is possible to instruct the system to
go to a new page when the "column heading" created in the crosstab query is
greater than 8. So that in the second page it will have the first 3 columns
plus the 9th column and onward in the query. Thanks.
The following is the code to create the report using the crosstab query.
Option Compare Database 'Use database order for string comparisons
Option Explicit
' Constant for maximum number of columns Pull Sheet query would
' create plus 1 for a Totals column.
Const TOTCOLS = 11
' Variables for database object and recordset.
Dim RptDB As Database
Dim RptRS As Recordset
' Variables for number of columns and row and report totals.
Dim IColCnt As Integer
Dim RgColTot(1 To TOTCOLS) As Long
Dim RptTotal As Long
Private Sub Detail1_Format(Cancel As Integer, FormatCount As Integer)
' Place values in text boxes and hide unused text boxes.
'
Dim i As Integer
' Verify that not at end of recordset.
If Not RptRS.EOF Then
' If FormatCount is 1, place values from recordsSet into text boxes
' in detail section.
If Me.FormatCount = 1 Then
For i = 1 To IColCnt
' Convert null values to 0.
Me("Col" + Format$(i)) = xtabCnulls(RptRS(i - 1))
Next i
' Hide unused text boxes in detail section.
For i = IColCnt + 2 To TOTCOLS
Me("Col" + Format$(i)).Visible = False
Next i
' Move to next record in recordset.
RptRS.MoveNext
End If
End If
End Sub
Private Sub Detail1_Retreat()
' Always back up to previous record when detail section retreats.
RptRS.MovePrevious
End Sub
Private Sub InitVars()
Dim i As Integer
' Initialize RptTotal variable.
RptTotal = 0
' Initialize array that stores column totals.
For i = 1 To TOTCOLS
RgColTot(i) = 0
Next i
End Sub
Private Sub PageHeader0_Format(Cancel As Integer, FormatCount As Integer)
Dim i As Integer
' Put column headings into text boxes in page header.
For i = 1 To IColCnt
Me("Head" + Format$(i)) = RptRS(i - 1).Name
Next i
' Hide unused text boxes in page header.
For i = (IColCnt + 2) To TOTCOLS
Me("Head" + Format$(i)).Visible = False
Next i
End Sub
Private Sub Report_Close()
DoCmd.Minimize
End Sub
Private Sub Report_Open(Cancel As Integer)
DoCmd.Maximize
' Create underlying recordset for report using criteria entered in
' Outcome Measure form.
'
Dim i As Integer
Dim MyQuery As QueryDef
' Don't open report if Outcome Measure form isn't loaded.
If Not (IsLoaded("Pull Sheet")) Then
Cancel = True
MsgBox "To preview or print this report, you must open the Packing
Slip in Form view.", 48, "Must Open Dialog Box"
Exit Sub
End If
' Set database variable to current database.
Set RptDB = DBEngine.Workspaces(0).Databases(0)
' Open QueryDef.
Set MyQuery = RptDB.QueryDefs("Qry_Host Purchase Order Pull Sheet")
' Set parameters for query based on values entered in Packing Slip
form.
MyQuery.Parameters("[Forms]![Pull Sheet]![Child23].[Form]![Host Purchase
Order]") = [Forms]![Pull Sheet]![Child23].[Form]![Host Purchase Order]
' Open Recordset.
Set RptRS = MyQuery.OpenRecordset()
' If no records match criteria, display message,
' close recordset, and cancel Open event.
If RptRS.RecordCount = 0 Then
MsgBox "No records match the criteria you entered.", 48, "No Records
Found"
RptRS.Close
Cancel = True
Exit Sub
End If
' Set a variable to hold number of columns in crosstab query.
IColCnt = RptRS.Fields.Count
End Sub
Private Sub ReportHeader3_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.)
RptRS.MoveFirst
'Initialize variables.
InitVars
End Sub
Private Function xtabCnulls(MyVal As Variant)
' Test if a value is null.
If IsNull(MyVal) Then
' If MyVal is null, set MyVal to 0.
xtabCnulls = 0
Else
' Otherwise, return MyVal.
xtabCnulls = MyVal
End If
End Function