Create Dynamic Report using VBA

[MMcCarthy]

This article contains three different approaches to creating dynamic reports.

• Dynamic report from user defined SQL SELECT statement (Author: mmccarthy)
• Dynamic report designed to be used with Crosstab Queries (Author: Nico5038)
• Dynamic report creation via AutoReport command (Author: FishVal)

Dynamic report from user defined SQL SELECT statement
You will sometimes find yourself in a position where you need to allow the users to create dynamic reports based on a user defined query. The following function will create such a report when passed any appropriate SQL SELECT statement.

[code=vb]
Function CreateDynamicRe port(strSQL As String)
Dim db As DAO.database ' database object
Dim rs As DAO.Recordset ' recordset object
Dim fld As DAO.Field ' recordset field
Dim txtNew As Access.TextBox ' textbox control
Dim lblNew As Access.Label ' label control
Dim rpt As Report ' hold report object
Dim lngTop As Long ' holds top value of control position
Dim lngLeft As Long ' holds left value of controls position
Dim title As String 'holds title of report

'set the title
title = "Title for the Report"

' initialise position variables
lngLeft = 0
lngTop = 0

'Create the report
Set rpt = CreateReport

' set properties of the Report
With rpt
.Width = 8500
.RecordSource = strSQL
.Caption = title
End With

' Open SQL query as a recordset
Set db = CurrentDb
Set rs = db.OpenRecordse t(strSQL)

' Create Label Title
Set lblNew = CreateReportCon trol(rpt.Name, acLabel, _
acPageHeader, , "Title", 0, 0)
lblNew.FontBold = True
lblNew.FontSize = 12
lblNew.SizeToFi t

' Create corresponding label and text box controls for each field.
For Each fld In rs.Fields

' Create new text box control and size to fit data.
Set txtNew = CreateReportCon trol(rpt.Name, acTextBox, _
acDetail, , fld.Name, lngLeft + 1500, lngTop)
txtNew.SizeToFi t

' Create new label control and size to fit data.
Set lblNew = CreateReportCon trol(rpt.Name, acLabel, acDetail, _
txtNew.Name, fld.Name, lngLeft, lngTop, 1400, txtNew.Height)
lblNew.SizeToFi t

' Increment top value for next control
lngTop = lngTop + txtNew.Height + 25
Next

' Create datestamp in Footer
Set lblNew = CreateReportCon trol(rpt.Name, acLabel, _
acPageFooter, , Now(), 0, 0)

' Create page numbering on footer
Set txtNew = CreateReportCon trol(rpt.Name, acTextBox, _
acPageFooter, , "='Page ' & [Page] & ' of ' & [Pages]", rpt.Width - 1000, 0)
txtNew.SizeToFi t

' Open new report.
DoCmd.OpenRepor t rpt.Name, acViewPreview

'reset all objects
rs.Close
Set rs = Nothing
Set rpt = Nothing
Set db = Nothing

End Function
[/code]


This report will not be saved until the user saves it or tries to close it. At which point they will be prompted to save it. You can play around with the layout of the report using the lngTop and lngLeft variables.

To call this function you simply need to pass a String parameter of a SQL statement to it as per the following.

CreateDynamicRe port "SELECT * FROM TableName"

To create that SQL SELECT statement you can set up a form to allow the user to select options to build the query. There is no facility in this code to validate the SQL query as it is assumed this is done elsewhere. But thats another article.


Dynamic report designed to be used with Crosstab Queries
This code is especially "tuned" for crosstab queries. As I like to have control over the layout, thus I have the lay-out designed first with "coded" controls. Then the dynamic filling becomes very easy. The raw text I use to help with this is:

Making the columnheader and detaildata flexible is possible, but needs some VBA code in the OpenReport event.

To start, doing this you need to place the fields "coded" in the report.
The column headings should be called "lblCol1", "lblCol2", "lblCol3", etc.
The "detail" fields should be called "Col1", "Col2", "Col3", etc.

The report query has two rowheader columns and a Total column, therefore the first field is effectively column 4 (count starts at 0 so I used intI=3) but this could differ for you.

Make sure that the number of Columns is not bigger than the number placed. The program code has no protection against that.

The code needed for the open report event is:

[code=vb]
Private Sub Report_Open(Can cel As Integer)
Dim intI As Integer
Dim rs As Recordset

Set rs = CurrentDb.OpenR ecordset(Me.Rec ordSource)

'Place headers
For intI = 3 To rs.Fields.Count - 1
Me("lblCol" & intI - 1).Caption = rs.Fields(intI) .Name
Next intI

'Place correct controlsource
For intI = 3 To rs.Fields.Count - 1
Me("Col" & intI - 1).ControlSourc e = rs.Fields(intI) .Name
Next intI

'Place Total field
Me.ColTotal.Con trolSource = "=SUM([" & rs.Fields(2).Na me & "])"

End Sub
[/code]

The report query has two rowheader columns and a Total column, therefor the first field is effectively column 4 (count starts at 0 so I used intI=3) but it could differ for you.


Dynamic report creation via AutoReport command
This code is used for dynamic report creation using the AutoReport command. You will first need to create a query and call it "qryDummy". This query is used by the code but the resulting report will not be based on the query as this would invalidate the report when the query was next changed.

[code=vb]
Public Sub CreateAutoRepor t(strSQL As String)
Dim rptReport As Access.Report
Dim strCaption As String

CurrentDb.Query Defs("qryDummy" ).SQL = strSQL

' Open dummy query to invoke NewObjectAutoRe port command on it
' Put the report created to design view to make properties editable
With DoCmd
.OpenQuery "qryDummy", acViewNormal
.RunCommand acCmdNewObjectA utoReport
.Close acQuery, "qryDummy"
.RunCommand acCmdDesignView
End With

' Get reference to just created report
For Each rpt In Reports
If rpt.Caption = "qryDummy" Then Set rptReport = rpt
Next

With rptReport

' Create title control
With CreateReportCon trol(.Name, acLabel, _
acPageHeader, , "Title", 0, 0)
.FontBold = True
.FontSize = 12
.SizeToFit
End With

' Create timestamp on footer
CreateReportCon trol .Name, acLabel, _
acPageFooter, , Now(), 0, 0

' Create page numbering on footer
With CreateReportCon trol(.Name, acTextBox, _
acPageFooter, , "='Page ' & [Page] & ' of ' & [Pages]", _
.Width - 1000, 0)
.SizeToFit
End With

' Detach the report from dummy query
.RecordSource = strSQL

' Set the report caption to autogenerated unique string
strCaption = GetUniqueReport Name
If strCaption <> "" Then .Caption = strCaption

End With

DoCmd.RunComman d acCmdPrintPrevi ew

Set rptReport = Nothing

End Sub


Public Function GetUniqueReport Name() As String
Dim intCounter As Integer
Dim blnIsUnique As Boolean

For intCounter = 1 To 256
GetUniqueReport Name = "rptAutoReport_ " & Format(intCount er, "0000")
blnIsUnique = True
For Each rpt In CurrentProject. AllReports
If rpt.Name = GetUniqueReport Name Then blnIsUnique = False
Next
If blnIsUnique Then Exit Function
Next

GetUniqueReport Name = ""

End Function
[/code]

[ioudas]

I was wondering how one would dynamically change the sizing of the columns in the field. Creating an auto report is nice but its messy. Here is the code I have now

Public Function StaticReportGen(SQLStr As String, Title As String, layout As String) As Boolean
    Dim strReportName       As String
    Dim rpt                 As Report
    Dim FieldName           As Field
    Dim RS                  As Recordset
    Dim intI                As Integer
    Dim ctrl                As Control
    Dim ColWidth            As Integer
    Dim FirstCol            As Boolean
    Dim TextWidth           As Integer
    Dim TextCol             As Boolean
    Dim TextBoxes           As Collection
    Dim Labels              As Collection
    Dim rsLengthCheck       As ADODB.Recordset
    Dim objConn             As ADODB.Connection
     
    On Error GoTo rptErrHandler

    ColWidth = 0
    TextWidth = 0
    TextCol = True
    FirstCol = True

    Set rpt = CreateReport()
    strReportName = rpt.Name
    rpt.Caption = Title
    
    DoCmd.RunCommand acCmdDesignView
    DoCmd.Save acReport, strReportName
    DoCmd.Close acReport, strReportName, acSaveNo
    DoCmd.Rename Title, acReport, strReportName
    DoCmd.OpenReport Title, acViewDesign
    Set rpt = Reports(Title)
    
    'set printer stuff
    rpt.Printer.BottomMargin = 360
    rpt.Printer.LeftMargin = 360
    rpt.Printer.RightMargin = 360
    rpt.Printer.TopMargin = 360
    
    If layout = "Landscape" Then
        rpt.Printer.Orientation = acPRORLandscape
    Else
        rpt.Printer.Orientation = acPRORPortrait
    End If
    
    Set RS = CurrentDb.OpenRecordset(SQLStr)
    rpt.RecordSource = SQLStr
    
    'create label on pageheader
    For Each FieldName In RS.Fields
        CreateReportControl Title, acLabel, acPageHeader, , FieldName.Name, 0, 0
        CreateReportControl Title, acTextBox, acDetail, , FieldName.Name, 0, 0
        '
    Next FieldName
    
    'arrange fields
    For Each ctrl In rpt.Controls
    
        Select Case ctrl.ControlType
            Case acTextBox
                If TextCol Then
                    ctrl.Name = ctrl.ControlSource
                    ctrl.Move TextWidth, 0, ctrl.WIDTH, ctrl.Height
                    TextWidth = TextWidth + ctrl.WIDTH
                Else
                    ctrl.Name = ctrl.ControlSource
                    ctrl.Move TextWidth, 0, ctrl.WIDTH, ctrl.Height
                    TextWidth = TextWidth + ctrl.WIDTH
                End If
                TextCol = False
            Case acLabel
                If FirstCol Then
                    ctrl.Name = "lbl" & ctrl.Caption
                    ctrl.Move ColWidth, 0, ctrl.WIDTH, ctrl.Height
                Else
                    ctrl.Name = "lbl" & ctrl.Caption
                    ctrl.Move TextWidth, 0, ctrl.WIDTH, ctrl.Height
                End If
                ctrl.FontSize = 10
                ctrl.FontWeight = 700
                FirstCol = False
            Case Else
            
        End Select
        
    Next ctrl
    'create line
    CreateReportControl Title, acLine, acPageHeader, , , 0, 300, rpt.WIDTH
    
    'create title
    CreateReportControl Title, acLabel, acHeader, , Title, 0, 0
    CreateReportControl Title, acTextBox, acHeader, , Chr(61) & Chr(34) & "Printed on:   " & Chr(34) & "& Date() ", 0, 300

    For Each ctrl In rpt.Controls
    
        Select Case ctrl.ControlType
            Case acTextBox
                If ctrl.Section = 1 Then
                    ctrl.FontWeight = 700
                    ctrl.FontSize = 14
                    ctrl.Height = 350
                    ctrl.WIDTH = 3500
                    ctrl.Top = 400
                End If
                
            Case acLabel
                If ctrl.Section = 1 Then
                    ctrl.FontSize = 16
                    ctrl.FontWeight = 700
                    ctrl.Height = 350
                    ctrl.WIDTH = 3500
                End If
        End Select
        
    Next ctrl
    
    'size fields correctly
    For Each ctrl In rpt.Controls
    
        Select Case ctrl.ControlType
        
            Case acTextBox
                For Each FieldName In RS.Fields
                    If ctrl.Name = FieldName Then
                        
                    End If
                Next FieldName
                
            Case acLabel
            
        End Select
        
    Next ctrl
    
    DoCmd.Save acReport, Title
    DoCmd.OpenReport Title, acViewPreview
    StaticReportGen = True
    Exit Function

rptErrHandler:
    Select Case Err.Number
    End Select
    StaticReportGen = False
    Debug.Print Err.Number
    Debug.Print Err.Description
    Exit Function
End Function

I want to use the textwidth property just having a block.

[J360]

Can you set a dynamic report to be tabular automatically?

Also, could somebody show what the code would look like to add groupings to a dynamic report?

I try

with rpt

.GroupLevel(0). controlsource = me.combo1.value

but keep getting "Error, no grouping or sorting command given"

Thanks.

[jl1406]

Groupings to Dynamic Report

Dim vargrplevel As Variant 'holds grouping level of report

vargrplevel = CreateGroupLeve l(rpt.Name, "[INSERT FIELD NAME]", True, True)
rpt.Section(acG roupLevel1Heade r).Height = 400
rpt.Section(acG roupLevel1Foote r).Height = 400



This will also create headers/footers for the grouping level.

[alinagoo]

Hi msquared

AutoReport Code has some Errors and problems
Can we correct them together?
Best regards
AliNagoo

[acheo]

Dynamic report from user defined SQL SELECT statement

The code does not exactly does what it's suppose to. Each record is displayed on a separate page. In the "for each field" section, the "Increment top value for next control" code does not do the job.

Any idea what is wrong with this?

Thanks

acheo

[alinagoo]

Cause!

Hello
I think It's more better to show every record in a page for me!
because the report's fields are numerous and the length of them is variable from zero to 255 character so i wont try to show records in another style like tabular.
Good Luck

[acheo]

I don't understand what you're saying. Clearly, the author wanted to display several records in a single page. I'm telling you that this does not work at run time. It merely displays the first record and then displays the second one on the followoing page. That defeats the purpose of having a report don't you think? So again, my question is: what should we change to have the records sequentially displayed?

thanks

[jai Kumar]

where can I get "Report", "CreateReportCo ntrol" "CreateRepo rt" etc functions used in this

[MMcCarthy]

These functions are standard in the default Access libraries in VBA. You shouldn't need to add any extra libraries to use them.

[Moah Scout]

For the case of Dynamic report designed to be used with Crosstab Queries (Author: Nico5038).
1. Is it possible to vary the number of column headings with this?
2. Where is the recordsourse of this Code?

[nico5038]

Hi Moah Scout,

For answering your questions:

1. The number of headings is "fixed", as you need to place the controls holding the results in the report design. The maximum number of columns thus needs to be known. When there are less columns as the max, there's no problem, as these won't be filled.
When there are more, the extra columns are ignored. With a little effort you could add a warning that there are more columns by using the .field.count property of the recordset.

2. The recordsource of the report holding the code is used in line 5:
Set rs = CurrentDb.OpenR ecordset(Me.Rec ordSource)

Thus this code is "universal" , for every report using this code.

Regards,

Nico

[Mr Key]

Ok!
What if the ColumnHeadings of Crosstab-Query changes and RowHeadings remain constant?
I mean, CrossTabQuery will be created from user selections on the combobox and thus the RowHeadings has to remain constant and the number ColumnHeadings Changes from 10 to 27.
Is it still possible to use this code?

[nico5038]

Then you'll need to "fix" column headers and not use:
>"The column headings should be called "lblCol1", "lblCol2", "lblCol3", etc."
As these will hold the desired values.

Also remove the code lines :

     'Place headers
     For intI = 3 To rs.Fields.Count - 1
         Me("lblCol" & intI - 1).Caption = rs.Fields(intI).Name
     Next intI

When the fields selected aren't in a "fixed" sequence, then you can fill the column value by building a loop and check when the fieldname is equal to the column heading to fill the column.
Another option is to "Fix" the query and make sure all fields are always in the same order and put "Dummy" (read Null) values in the not used columns.

Getting the idea ?

Nico

[sori]

1.Can you set a dynamic report to be tabular automatically?

2.I have also tried to group some data using this code, but it doesn't seem to do anything:

varGroupLevel = CreateGroupLevel(report.Name, "data_curs", _
        True, True)
report.Section(acGroupLevel1Header).Height = 400
report.Section(acGroupLevel1Footer).Height = 400