JessicaVdb
Registered User.
- Local time
- Tomorrow, 00:33
- Joined
- Jul 4, 2017
- Messages
- 32
I am making a dynamic report with a crosstab query. My problem is that the report need to have changing headings. I looked on this site and many others, to find a solution. But I still havent found one. I put here my code in the hope someone knows what the problem is in my VBA-code.
Thanks
JessicaVdb
Thanks
JessicaVdb
Code:
' Constant for maximum number of columns EmployeeSales query would
Const conTotalColumns = 18
' Variables for Database object and Recordset.
Dim dbsReport As DAO.Database
Dim rstReport As DAO.Recordset
' Variables for number of columns and row.
Dim intColumnCount As Integer
Dim lngRgColumnTotal(1 To conTotalColumns) As Long
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
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
' Put values in text boxes and hide unused text boxes.
Dim intX As Integer
' Verify that you are not at end of recordset.
If Not rstReport.EOF Then
' If FormatCount is 1, put 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 the "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 the "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
' Put row total in text box in the "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 Detail_Retreat()
' Always back up to previous record when "Detail" section retreats.
rstReport.MovePrevious
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)) = "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_Close()
On Error Resume Next
' Close recordset.
rstReport.Close
End Sub
Private Sub Report_NoData(Cancel As Integer)
MsgBox "Probeer opnieuw", 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.
Dim intX As Integer
Dim qdf As QueryDef
Dim frm As Form
' Set database variable to current database.
Set dbsReport = CurrentDb
Set frm = Forms!MainMenuF
' Open QueryDef object.
Set qdf = dbsReport.QueryDefs("TrainingMatrixQ_Kruistabel")
' 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 ReportHeader_Format(Cancel As Integer, FormatCount As Integer)
' Move to first record in recordset at the beginning of the report
' or when the 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
