E
ECA
I have followed the support.mdb suggestion to create a report with Dynamic
Headings. I created unbound fields called Head1 - Head 22, Col1 -Col22 and
Tot1 - Tot22 When I try to run the report it comes up blank. I believe the
code is wrong. I am sure with the right code it will work. Attached is the
code I currently have in can anyone help?
Option Compare Database 'Use database order for string comparisons.
Option Explicit
' Constant for maximum number of columns Ops Plan: Throughput - Monthly by
Loc (KGals) query would
' create plus 1 for a Totals column.
Const conTotalColumns = 23
' 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 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 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 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 = 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
End Sub
Private Sub Detail1_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 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 intColumnCount
Me("Head" + Format(intX)) = rstReport(intX - 1).Name
Next intX
' Make next available text box Totals heading.
Me("Head" + Format(intColumnCount + 1)) = "Totals"
' 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_Activate()
' Hide built-in Print Preview toolbar.
DoCmd.ShowToolbar "Print Preview", acToolbarNo
End Sub
Private Sub Report_Close()
On Error Resume Next
' Close recordset.
rstReport.Close
End Sub
Private Sub Report_Deactivate()
' Show built-in Print Preview toolbar.
DoCmd.ShowToolbar "Print Preview", acToolbarWhereApprop
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 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 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.)
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
THANKS
Headings. I created unbound fields called Head1 - Head 22, Col1 -Col22 and
Tot1 - Tot22 When I try to run the report it comes up blank. I believe the
code is wrong. I am sure with the right code it will work. Attached is the
code I currently have in can anyone help?
Option Compare Database 'Use database order for string comparisons.
Option Explicit
' Constant for maximum number of columns Ops Plan: Throughput - Monthly by
Loc (KGals) query would
' create plus 1 for a Totals column.
Const conTotalColumns = 23
' 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 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 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 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 = 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
End Sub
Private Sub Detail1_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 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 intColumnCount
Me("Head" + Format(intX)) = rstReport(intX - 1).Name
Next intX
' Make next available text box Totals heading.
Me("Head" + Format(intColumnCount + 1)) = "Totals"
' 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_Activate()
' Hide built-in Print Preview toolbar.
DoCmd.ShowToolbar "Print Preview", acToolbarNo
End Sub
Private Sub Report_Close()
On Error Resume Next
' Close recordset.
rstReport.Close
End Sub
Private Sub Report_Deactivate()
' Show built-in Print Preview toolbar.
DoCmd.ShowToolbar "Print Preview", acToolbarWhereApprop
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 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 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.)
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
THANKS