I have created a report that reports the data from crosstab queries into unbound fields on the report.
If I explicitly define the query name in both the report properties and the report VBA everything works fine.
Since I have about a dozen queries to run I am trying to create a single report that will accept the query name as a variable via a button click on a form.
This way when I need to change the report I only have to change one report rather than 12 reports.
Unfortunately, I'm running into problems with my code.
Here is what I have done:
In a global Function module I have:
Public DataSource As String
In the On Click event of a form I have:
Private Sub btnRptAllProducts_Click()
On Error GoTo Err_btnRptAllAgProducts_Click
Dim stDocName As String
DataSource = "qxtabWeekly&FutureRequirements"
stDocName = "rptWeekly&FutureReqirements-14Col"
DoCmd.OpenReport stDocName, acPreview
Exit_btnRptAllAgProducts_Click:
Exit Sub
Err_btnRptAllAgProducts_Click:
MsgBox Err.Description
Resume Exit_btnRptAllAgProducts_Click
End Sub
In the reports On Open event I have:
'Point at the correct data source.
Set qdf = db.QueryDefs(DataSource)
'Open Recordset object.
Set mrstReport = qdf.OpenRecordset
The original report is based on another query.
If I leave the name of the original query in the Record Source field of the properties box I get all data but with the last product number repeated many times. (It appears the report is trying to generate the exact smae number of lines as it would if it used the Record Source field of the properties box).
You would think the logical solution would be to delete the Record Source field of the properties box. Not so lucky!
If I remove the original query in the Record Source field of the properties box and leave that property blank, the report only displays a single line. Aaargh!
I would greatly appreciate any help you can offer.
Thanks in advance.
BTW. Here is the full report VBA if you need it:
---------------------------------
Option Compare Database 'Use database order for string comparisons.
Option Explicit
' Constant for maximum number of columns EmployeeSales query would
' create plus 1 for a Totals column.
Const conTotalColumns = 11
' Variables for Database object and Recordset.
Dim mrstReport As DAO.Recordset
' Variables for number of columns and row and report totals.
Dim mintColumnCount As Integer
Dim mlngRgColumnTotal(1 To conTotalColumns) As Long
Dim mlngReportTotal As Long
Private Sub Detail1_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 mrstReport.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 mintColumnCount
'Convert Null values to 0.
Me("Col" + Format(intX)) = xtabCnulls(mrstReport(intX - 1))
Next intX
'Hide unused text boxes in detail section.
For intX = mintColumnCount + 1 To conTotalColumns
Me("Col" + Format(intX)).Visible = False
Next intX
'Move to next record in recordset.
mrstReport.MoveNext
End If
End If
End Sub
Private Sub Detail1_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 = 6 To mintColumnCount
' Starting at column 6 (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.
mlngRgColumnTotal(intX) = mlngRgColumnTotal(intX) + _
Me("Col" + Format(intX))
Next intX
' Place row total in text box in detail section.
' Me("Col" + Format(mintColumnCount + 1)) = lngRowTotal
Me("Col12"
= lngRowTotal
' Add row total for current row to grand total.
mlngReportTotal = mlngReportTotal + lngRowTotal
End If
End Sub
Private Sub Detail1_Retreat()
' Always back up to previous record when detail section retreats.
mrstReport.MovePrevious
End Sub
Private Sub InitVars()
Dim intX As Integer
'Initialize lngReportTotal variable.
mlngReportTotal = 0
'Initialize array that stores column totals.
For intX = 1 To conTotalColumns
mlngRgColumnTotal(intX) = 0
Next intX
End Sub
Private Sub PageHeader0_Format(Cancel As Integer, FormatCount As Integer)
Dim intX As Integer
'Put column headings into text boxes in page header.
For intX = 1 To mintColumnCount
Me("Head" + Format(intX)) = mrstReport(intX - 1).Name
Next intX
'Make next available text box Totals heading.
Me("Head12"
= "Totals"
'Hide unused text boxes in page header.
For intX = (mintColumnCount + 1) To conTotalColumns
Me("Head" + Format(intX)).Visible = False
Next intX
End Sub
Private Sub Report_Close()
On Error Resume Next
' Close recordset.
mrstReport.Close
End Sub
Private Sub Report_NoData(Cancel As Integer)
MsgBox "No records match the criteria you entered.", vbExclamation, "No Records Found"
mrstReport.Close
Cancel = True
End Sub
Private Sub Report_Open(Cancel As Integer)
'Create underlying recordset for report using criteria entered in
'frmEmployeeSalesDialogBox form.
Dim intX As Integer
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim frm As Form
Set db = CurrentDb
'Point at the correct data source.
Set qdf = db.QueryDefs(DataSource)
' Set qdf = db.QueryDefs("qxtabWeekly&FutureRequirements-AftermarketSpring-withSafetyStock"
'Open Recordset object.
Set mrstReport = qdf.OpenRecordset
'Set a variable to hold number of columns in crosstab query.
mintColumnCount = mrstReport.Fields.Count
' adjust mincount to deal with maximum number of fields in report
If mintColumnCount > 11 Then
mintColumnCount = 11
End If
End Sub
Private Sub ReportFooter4_Print(Cancel As Integer, PrintCount As Integer)
Dim intX As Integer
' Place column totals in text boxes in report footer.
' Start at column 4 (first text box with crosstab value).
For intX = 4 To mintColumnCount
Me("Tot" + Format(intX)) = mlngRgColumnTotal(intX)
Next intX
' Place grand total in text box in report footer.
Me("Tot" + Format(mintColumnCount + 1)) = mlngReportTotal
' Hide unused text boxes in report footer.
For intX = mintColumnCount + 2 To conTotalColumns
Me("Tot" + Format(intX)).Visible = False
Next intX
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.)
mrstReport.MoveFirst
'Initialize variables.
Call InitVars
End Sub
Private Function xtabCnulls(varX As Variant)
' Test if a value is null.
xtabCnulls = Nz(varX, 0)
End Function
If I explicitly define the query name in both the report properties and the report VBA everything works fine.
Since I have about a dozen queries to run I am trying to create a single report that will accept the query name as a variable via a button click on a form.
This way when I need to change the report I only have to change one report rather than 12 reports.
Unfortunately, I'm running into problems with my code.
Here is what I have done:
In a global Function module I have:
Public DataSource As String
In the On Click event of a form I have:
Private Sub btnRptAllProducts_Click()
On Error GoTo Err_btnRptAllAgProducts_Click
Dim stDocName As String
DataSource = "qxtabWeekly&FutureRequirements"
stDocName = "rptWeekly&FutureReqirements-14Col"
DoCmd.OpenReport stDocName, acPreview
Exit_btnRptAllAgProducts_Click:
Exit Sub
Err_btnRptAllAgProducts_Click:
MsgBox Err.Description
Resume Exit_btnRptAllAgProducts_Click
End Sub
In the reports On Open event I have:
'Point at the correct data source.
Set qdf = db.QueryDefs(DataSource)
'Open Recordset object.
Set mrstReport = qdf.OpenRecordset
The original report is based on another query.
If I leave the name of the original query in the Record Source field of the properties box I get all data but with the last product number repeated many times. (It appears the report is trying to generate the exact smae number of lines as it would if it used the Record Source field of the properties box).
You would think the logical solution would be to delete the Record Source field of the properties box. Not so lucky!
If I remove the original query in the Record Source field of the properties box and leave that property blank, the report only displays a single line. Aaargh!
I would greatly appreciate any help you can offer.
Thanks in advance.
BTW. Here is the full report VBA if you need it:
---------------------------------
Option Compare Database 'Use database order for string comparisons.
Option Explicit
' Constant for maximum number of columns EmployeeSales query would
' create plus 1 for a Totals column.
Const conTotalColumns = 11
' Variables for Database object and Recordset.
Dim mrstReport As DAO.Recordset
' Variables for number of columns and row and report totals.
Dim mintColumnCount As Integer
Dim mlngRgColumnTotal(1 To conTotalColumns) As Long
Dim mlngReportTotal As Long
Private Sub Detail1_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 mrstReport.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 mintColumnCount
'Convert Null values to 0.
Me("Col" + Format(intX)) = xtabCnulls(mrstReport(intX - 1))
Next intX
'Hide unused text boxes in detail section.
For intX = mintColumnCount + 1 To conTotalColumns
Me("Col" + Format(intX)).Visible = False
Next intX
'Move to next record in recordset.
mrstReport.MoveNext
End If
End If
End Sub
Private Sub Detail1_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 = 6 To mintColumnCount
' Starting at column 6 (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.
mlngRgColumnTotal(intX) = mlngRgColumnTotal(intX) + _
Me("Col" + Format(intX))
Next intX
' Place row total in text box in detail section.
' Me("Col" + Format(mintColumnCount + 1)) = lngRowTotal
Me("Col12"
' Add row total for current row to grand total.
mlngReportTotal = mlngReportTotal + lngRowTotal
End If
End Sub
Private Sub Detail1_Retreat()
' Always back up to previous record when detail section retreats.
mrstReport.MovePrevious
End Sub
Private Sub InitVars()
Dim intX As Integer
'Initialize lngReportTotal variable.
mlngReportTotal = 0
'Initialize array that stores column totals.
For intX = 1 To conTotalColumns
mlngRgColumnTotal(intX) = 0
Next intX
End Sub
Private Sub PageHeader0_Format(Cancel As Integer, FormatCount As Integer)
Dim intX As Integer
'Put column headings into text boxes in page header.
For intX = 1 To mintColumnCount
Me("Head" + Format(intX)) = mrstReport(intX - 1).Name
Next intX
'Make next available text box Totals heading.
Me("Head12"
'Hide unused text boxes in page header.
For intX = (mintColumnCount + 1) To conTotalColumns
Me("Head" + Format(intX)).Visible = False
Next intX
End Sub
Private Sub Report_Close()
On Error Resume Next
' Close recordset.
mrstReport.Close
End Sub
Private Sub Report_NoData(Cancel As Integer)
MsgBox "No records match the criteria you entered.", vbExclamation, "No Records Found"
mrstReport.Close
Cancel = True
End Sub
Private Sub Report_Open(Cancel As Integer)
'Create underlying recordset for report using criteria entered in
'frmEmployeeSalesDialogBox form.
Dim intX As Integer
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim frm As Form
Set db = CurrentDb
'Point at the correct data source.
Set qdf = db.QueryDefs(DataSource)
' Set qdf = db.QueryDefs("qxtabWeekly&FutureRequirements-AftermarketSpring-withSafetyStock"
'Open Recordset object.
Set mrstReport = qdf.OpenRecordset
'Set a variable to hold number of columns in crosstab query.
mintColumnCount = mrstReport.Fields.Count
' adjust mincount to deal with maximum number of fields in report
If mintColumnCount > 11 Then
mintColumnCount = 11
End If
End Sub
Private Sub ReportFooter4_Print(Cancel As Integer, PrintCount As Integer)
Dim intX As Integer
' Place column totals in text boxes in report footer.
' Start at column 4 (first text box with crosstab value).
For intX = 4 To mintColumnCount
Me("Tot" + Format(intX)) = mlngRgColumnTotal(intX)
Next intX
' Place grand total in text box in report footer.
Me("Tot" + Format(mintColumnCount + 1)) = mlngReportTotal
' Hide unused text boxes in report footer.
For intX = mintColumnCount + 2 To conTotalColumns
Me("Tot" + Format(intX)).Visible = False
Next intX
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.)
mrstReport.MoveFirst
'Initialize variables.
Call InitVars
End Sub
Private Function xtabCnulls(varX As Variant)
' Test if a value is null.
xtabCnulls = Nz(varX, 0)
End Function