Article ID: 203992
Article Last Modified on 10/11/2006
Option Compare Database Option Explicit Public arySampleData() As Variant Public strReportName As String
Public Sub FillArray()
Dim aryItem As Long
For aryItem = 0 To 9
ReDim Preserve arySampleData(aryItem)
arySampleData(aryItem) = "Item " & aryItem
Next aryItem
End Sub
Sub TempReport()
Dim rpt As Report
Dim mdl As Module
Dim strCode As String
Dim lngReturn As Long
Dim ctlLabel1 As Control, ctlText1 As Control
Dim intDataX As Integer, intDataY As Integer
Dim intLineCount As Integer, intCounter As Integer
' Turn off the screen updating. Comment this line out during
' testing because it prevents user interaction if the code fails.
Application.Echo False
' Create new report and store the name.
Set rpt = CreateReport
strReportName = rpt.Name
' Expose the report header.
DoCmd.RunCommand acCmdReportHdrFtr
Set mdl = rpt.Module
intLineCount = mdl.CountOfLines
strCode = "Dim intCounter as Integer"
mdl.InsertLines intLineCount, strCode
lngReturn = mdl.CreateEventProc("Print", rpt.Section(acHeader).Name)
strCode = "intCounter=0" & vbCrLf & "FillArray"
mdl.InsertLines lngReturn + 1, strCode
lngReturn = mdl.CreateEventProc("Print", rpt.Section(acDetail).Name)
strCode = "Me!txtTest.Value= arySampleData(intCounter)" & vbCrLf
strCode = strCode & "Me!lblTest.Caption= ""Array Value""" & vbCrLf
strCode = strCode & "If intCounter <> UBound(arySampleData)" _
& "Then Me.nextrecord=False" & vbCrLf
strCode = strCode & "intCounter=intCounter+1"
mdl.InsertLines lngReturn + 1, strCode
' Set positioning values for report controls.
' Measurements are in twips.
intDataX = 500
intDataY = 50
' Create unbound default-size label and text box in detail section.
rpt.Section(acDetail).Height = 400
Set ctlLabel1 = CreateReportControl(reportname:=strReportName, _
ControlType:=acLabel, Left:=intDataX, Top:=intDataY, _
Width:=1440, Height:=240)
ctlLabel1.Name = "lblTest"
Set ctlText1 = CreateReportControl(reportname:=strReportName, _
ControlType:=acTextBox, Left:=(intDataX + 1440), Top:=intDataY)
ctlText1.Name = "txtTest"
' Turn the screen back on.
Application.Echo True
End Sub
Function BuildReport() ' Call the TempReport procedure. TempReport ' Print the report without showing it in preview mode. DoCmd.OpenReport strReportName, acViewNormal ' Close the report without saving it. DoCmd.Close acReport, strReportName, acSaveNo End Function
?BuildReport()
Keywords: kbdta kbhowto kbofficeprog kbprogramming kbvba KB203992