
Adding ReportHeader/Footer Programmatically
Hi Peter,
I seem to remember having some problems as well. FWIW, here's the code
that I ended up using for Access 95 database through Automation from VB.
Full code is here
< http://home.att.net/~dashish/modules/mdl0029.htm >
'******** Code Start *********
Private Sub sReportSections()
Dim strOrigName As String
Dim strCopyName As String
Dim sec As Object
Dim intI As Integer
Dim intJ As Integer
Dim prp As Object
Dim grpOrig As Object
Dim grpCopy As Object
Dim varGrpCopy As Variant
Dim intTmp As Integer
Dim dblHeight As Double
Dim tRpt As tReport
Const conMAXGROUPS = 9
On Error Resume Next
intI = 0
strOrigName = mrptOrig.Name
strCopyName = mrptCopy.Name
'Determine whether the report has header/footer
intTmp = mrptOrig.Section(AcSection.acHeader).Visible
If Err.Number = 0 Then mblnRptHdrFtr = True
'Store group level info
Do While intI <= conMAXGROUPS
Set grpOrig = mrptOrig.GroupLevel(intI)
If Err.Number <> 0 Then Exit Do
ReDim Preserve matGrpInfo(intI)
With matGrpInfo(intI)
.intSection = intI
.intGroupFooter = grpOrig.GroupFooter
.intGroupHeader = grpOrig.GroupHeader
.strControlSource = grpOrig.ControlSource
ReDim Preserve .atProps(grpOrig.Properties.Count - 1)
For intJ = 0 To UBound(.atProps) - 1
Set prp = grpOrig.Properties(intJ)
.atProps(intJ).strPropName = prp.Name
.atProps(intJ).varPropValue = prp.Value
Next
End With
intI = intI + 1
Loop
'read all Report properties
tRpt.strReportName = strOrigName
ReDim Preserve tRpt.atProps(mrptOrig.Properties.Count - 1)
With mrptOrig
For intI = 0 To UBound(tRpt.atProps)
Set prp = .Properties(intI)
tRpt.atProps(intI).strPropName = prp.Name
tRpt.atProps(intI).varPropValue = prp.Value
Next
End With
'All section properties
intI = 0
intTmp = 0
Err.Clear
Do While intI <= 8
With mrptOrig
Set sec = .Section(intI)
If Err.Number = 0 Then
ReDim Preserve matSection(intTmp)
matSection(intTmp).intSection = intTmp
matSection(intTmp).strName = sec.Name
ReDim Preserve
matSection(intTmp).atProps(sec.Properties.Count)
For intJ = 0 To sec.Properties.Count - 1
Set prp = sec.Properties(intJ)
matSection(intTmp).atProps(intJ).strPropName = prp.Name
matSection(intTmp).atProps(intJ).varPropValue =
prp.Value
Next
intTmp = intTmp + 1
End If
End With
intI = intI + 1
Loop
'Create groups, first displaying the header/footer
If mblnRptHdrFtr Then
With mobjAcc95
.DoCmd.SelectObject AcObjectType.acReport, strCopyName, False
.DoCmd.DoMenuItem 7, 2, 11, 0, AcVersion.acMenuVer70
End With
End If
For intI = 0 To UBound(matGrpInfo)
With matGrpInfo(intI)
varGrpCopy = mobjAcc95.CreateGroupLevel( _
strCopyName, _
.strControlSource, _
.intGroupHeader, _
.intGroupFooter)
Set grpCopy = mrptCopy.GroupLevel(intI)
For intJ = 0 To UBound(.atProps) - 1
grpCopy.Properties(.atProps(intJ).strPropName) = _
.atProps(intJ).varPropValue
Next
End With
Next
'Assign Report Properties
With mrptCopy
For intI = 0 To UBound(tRpt.atProps)
.Properties(tRpt.atProps(intI).strPropName) = _
tRpt.atProps(intI).varPropValue
Next
End With
'Assign section properties
With mrptCopy
For intI = 0 To UBound(matSection)
Set sec = .Section(matSection(intI).intSection)
sec.Name = matSection(intI).strName
For intJ = 0 To UBound(matSection(intI).atProps)
sec.Properties(matSection(intI).atProps(intJ).strPropName) =
_
matSection(intI).atProps(intJ).varPropValue
Next
Next
End With
End Sub
'*********** Code End **********
HTH
--
Dev Ashish (Just my $.001)
---------------
The Access Web ( http://home.att.net/~dashish )
---------------
: I would like to create a report and add a ReportHeader/Footer within a VBA
: module. I can't get DoCmd.RunCommand acCmdReportHdrFtr to work and that
is
: the only way I can find to create the ReportHeader/Footer sections.
:
: