Its hard to explain because it works with many sections
and one Summary field but I'll try.
Here goes:
The purpose of this code is to override the properties of
the footer/header based on data fields or flags in the
related sections of the report. This works fine when I
have only one calculated field in the footer but as soon
as I add another one it tells me the objects of the passed
footer no longer exist ... but they do!
Conventions:
L2H is Group 2 Header
L2F is the Group 2 Footer.
L2FTRHIDE is a text box in L2FOOTER fed by the recordset
of the report.
l2FOverRide is a text box in L2FOOTER fed by the recordset
of the report.
The Text boxes with Tag's set for Label and Col are the
only ones I want to change properties for.
I have Summary Fields on the report with Col Tags like
In Section 2 footer (L2F)
Name:L2EndingBalance
Source:=Sum(txtEndingBalance)
Name:L2YTDBalance
Source:=Sum(txtYTDBalance)
In Section 2 footer (L2F)
Name:L3EndingBalance
Source:=Sum(txtEndingBalance)
Name:L3YTDBalance
Source:=Sum(txtYTDBalance)
The Code:
Private Sub L2F_Format(Cancel As Integer, FormatCount As
Integer)
If L2FTRHIDE = 1 Or IsNull(L2FTRTXT) Or (L2FTRTXT
= " ") Then
L2F.Visible = False
Else
L2F.Visible = True
If l2FOverRide = 1 Then
Call PropOverride(L2F, l2fuserref1, 3)
End If
End If
End Sub
Private Sub L2H_Format(Cancel As Integer, FormatCount As
Integer)
If l2hdrhide = 1 Or IsNull(L2HDRTXT) Or (L2HDRTXT
= " ") Then
L2H.Visible = False
Else
L2H.Visible = True
If l2HOverRide = 1 Then
Call PropOverride(L2H, l2Huserref1, 1)
End If
End If
End Sub
Private Sub L3F_Format(Cancel As Integer, FormatCount As
Integer)
If L3FTRHIDE = 1 Or IsNull(L3FTRTXT) Or (L3FTRTXT
= " ") Then
L3F.Visible = False
Else
L3F.Visible = True
If l3FOverRide = 1 Then
Call PropOverride(L3F, l3Fuserref1, 3)
End If
End If
End Sub
Private Sub L3H_Format(Cancel As Integer, FormatCount As
Integer)
If l3hdrhide = 1 Or IsNull(L3HDRTXT) Or (L3HDRTXT
= " ") Then
L3H.Visible = False
Else
L3H.Visible = True
If l3HOverRide = 1 Then
Call PropOverride(L3H, l3Huserref1, 1)
End If
End If
End Sub
Private Sub PropOverride(MySection As Section,
MySectionNode As String, MySectionType As Integer)
On Error GoTo PropOverride_err
Dim MyPropArray() As PropArray
Dim PDB As Database
Dim I As Integer
Dim Propset As Recordset
Dim PropSQl As String
Dim S As Integer
Dim MyProp As Property
'Load the data into an array and clos the dataset for
speed.
PropSQl = "Select P.* from NodeProperties as P where
P.Node ='" & MySectionNode & "' and P.Layout in(" &
MySectionType & "," & MySectionType + 3 & ") and
PropertyName <>'Default'"
Set PDB = CurrentDb()
Set Propset = PDB.OpenRecordset(PropSQl)
I = 0
If Not Propset.EOF Then
Propset.MoveLast
Propset.MoveFirst
ReDim MyPropArray(Propset.RecordCount)
While Not Propset.EOF
MyPropArray(I).Propname = Propset!PropertyName
MyPropArray(I).PropValue = Propset!PropertyValue
MyPropArray(I).PropSection = Propset!Layout
If Propset!PropertyName = "ForcePageBreak" Then
MySection.ForceNewPage = 2
End If
I = I + 1
Propset.MoveNext
Wend
Propset.Close
End If
'Now we have an array loaded with the right values
'Now find the controls that have tags of Label and Col
'And set the properties based on the array
For S = 0 To MySection.Controls.Count - 1
If UCase(MySection.Controls(S).Tag) = "LABEL" Then
For Each MyProp In MySection.Controls(S).Properties
For I = LBound(MyPropArray) To UBound
(MyPropArray)
If MyPropArray(I).Propname = MyProp.Name
And MyPropArray(I).PropSection = CStr(MySectionType) Then
MyProp.Value = MyPropArray(I).PropValue
Debug.Print "Setting " &
MySection.Controls(S).Name & " ("; MySection.Controls
(S).Value & ") Property " & MyProp.Name & " To " &
MyPropArray(I).PropValue
End If
Next I
Next MyProp
End If
If UCase(MySection.Controls(S).Tag) = "COL" Then
For Each MyProp In MySection.Controls(S).Properties
For I = LBound(MyPropArray) To UBound
(MyPropArray)
If MyPropArray(I).Propname = MyProp.Name
And MyPropArray(I).PropSection = CStr(MySectionType + 3)
Then
Debug.Print "Setting " &
MySection.Controls(S).Name & " ("; MySection.Controls
(S).Value & ") Property " & MyProp.Name & " To " &
MyPropArray(I).PropValue
MyProp.Value = MyPropArray(I).PropValue
End If
Next I
Next MyProp
End If
Next S
'give back a little memory
ReDim MyPropArray(0)
PropOverride_exit:
Exit Sub
PropOverride_err:
MsgBox "Stopped Here"
Resume PropOverride_exit
End Sub
There! Clear as mud!
NMcQ