使用VBA创建动态报告

本文包含三种创建动态报告的方法。

• 用户定义的SQL SELECT语句的动态报告（作者： mmccarthy ）
• 设计为与交叉表查询一起使用的动态报告（作者： Nico5038 ）
• 通过AutoReport命令创建动态报告（作者： FishVal ）

用户定义的SQL SELECT语句的动态报告

有时您会发现自己处于允许用户根据用户定义的查询创建动态报告的位置。 当传递任何适当的SQL SELECT语句时，以下函数将创建此类报告。

Function CreateDynamicReport(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.OpenRecordset(strSQL)     
     ' Create Label Title
     Set lblNew = CreateReportControl(rpt.Name, acLabel, _
     acPageHeader, , "Title", 0, 0)
     lblNew.FontBold = True
     lblNew.FontSize = 12
     lblNew.SizeToFit 
     ' 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 = CreateReportControl(rpt.Name, acTextBox, _
         acDetail, , fld.Name, lngLeft + 1500, lngTop)
         txtNew.SizeToFit 
         ' Create new label control and size to fit data.
         Set lblNew = CreateReportControl(rpt.Name, acLabel, acDetail, _
         txtNew.Name, fld.Name, lngLeft, lngTop, 1400, txtNew.Height)
         lblNew.SizeToFit         
         ' Increment top value for next control
         lngTop = lngTop + txtNew.Height + 25
     Next 
     ' Create datestamp in Footer
     Set lblNew = CreateReportControl(rpt.Name, acLabel, _
     acPageFooter, , Now(), 0, 0) 
     ' Create page numbering on footer
     Set txtNew = CreateReportControl(rpt.Name, acTextBox, _
     acPageFooter, , "='Page ' & [Page] & ' of ' & [Pages]", rpt.Width - 1000, 0)
     txtNew.SizeToFit 
     ' Open new report.
     DoCmd.OpenReport rpt.Name, acViewPreview 
     'reset all objects
     rs.Close
     Set rs = Nothing
     Set rpt = Nothing
     Set db = Nothing 
End Function 

除非用户保存或尝试关闭该报告，否则不会保存该报告。 这时将提示他们保存它。 您可以使用lngTop和lngLeft变量来处理报表的布局。

要调用此函数，您只需按照以下说明将SQL语句的String参数传递给它。

CreateDynamicReport“ SELECT * FROM TableName”

要创建该SQL SELECT语句，您可以设置一个表单以允许用户选择用于构建查询的选项。 假定已在其他地方完成此代码，则此代码中没有工具可以验证SQL查询。 但这就是另一篇文章。

设计用于交叉表查询的动态报告

此代码特别适合交叉表查询。 由于我希望控制布局，因此我首先使用“编码”控件设计了布局。 然后，动态填充变得非常容易。 我用来帮助解决此问题的原始文本是：

使columnheader和detaildata灵活一些是可能的，但在OpenReport事件中需要一些VBA代码。

首先，您需要在报告中放置“已编码”字段。

列标题应称为“ lblCol1”，“ lblCol2”，“ lblCol3”等。

“详细信息”字段应称为“ Col1”，“ Col2”，“ Col3”等。

报表查询有两个行标题列和一个总计列，因此第一个字段实际上是列4（计数从0开始，所以我使用intI = 3），但这可能与您有所不同。

确保列数不大于放置的数。 程序代码对此没有保护。

打开报告事件所需的代码是：

Private Sub Report_Open(Cancel As Integer)
Dim intI As Integer
Dim rs As Recordset 
     Set rs = CurrentDb.OpenRecordset(Me.RecordSource) 
     '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).ControlSource = rs.Fields(intI).Name
     Next intI 
     'Place Total field
     Me.ColTotal.ControlSource = "=SUM([" & rs.Fields(2).Name & "])"    
End Sub 

报表查询有两个行标题列和一个总计列，因此第一个字段实际上是第4列（计数从0开始，因此我使用intI = 3），但它可能与您有所不同。 通过自动报告命令动态创建报告

此代码用于使用AutoReport命令创建动态报告。 您首先需要创建一个查询并将其命名为“ qryDummy”。 该代码使用该查询，但是结果报告将不基于该查询，因为这将在下次更改查询时使该报告无效。

Public Sub CreateAutoReport(strSQL As String)
Dim rptReport As Access.Report
Dim strCaption As String 
     CurrentDb.QueryDefs("qryDummy").SQL = strSQL 
     ' Open dummy query to invoke NewObjectAutoReport command on it
     ' Put the report created to design view to make properties editable
     With DoCmd
         .OpenQuery "qryDummy", acViewNormal
         .RunCommand acCmdNewObjectAutoReport
         .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 CreateReportControl(.Name, acLabel, _
             acPageHeader, , "Title", 0, 0)
             .FontBold = True
             .FontSize = 12
             .SizeToFit
         End With 
         ' Create timestamp on footer
         CreateReportControl .Name, acLabel, _
             acPageFooter, , Now(), 0, 0 
         ' Create page numbering on footer
         With CreateReportControl(.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 = GetUniqueReportName
         If strCaption <> "" Then .Caption = strCaption 
     End With 
     DoCmd.RunCommand acCmdPrintPreview 
     Set rptReport = Nothing 
End Sub  
Public Function GetUniqueReportName() As String
Dim intCounter As Integer
Dim blnIsUnique As Boolean 
     For intCounter = 1 To 256 
         GetUniqueReportName = "rptAutoReport_" & Format(intCounter, "0000")
         blnIsUnique = True
         For Each rpt In CurrentProject.AllReports
             If rpt.Name = GetUniqueReportName Then blnIsUnique = False
         Next
         If blnIsUnique Then Exit Function
     Next 
     GetUniqueReportName = "" 
End Function 

From: https://bytes.com/topic/access/insights/696050-create-dynamic-report-using-vba