Help with code to "blank" reports

[DawnTreader]

Hello All

i need help. i am so close to figuring this out. i have a set of reports
that i am trying to create code to "blank" by changing the fore color of the
controls that show, so that i get a blank printable version of the report. to
do this i ammended some code and the only problem i am having is with the
subreports.

here is the code as it currently stands:

Public Function BlankDataControlsOnReports(rpt As Report, controlColor As
Boolean)
On Error GoTo Err_Handler
'Purpose: change the fore color of the bound controls and on the
reports and any of its subreports.
'Arguments rpt = the form to be changed
' controlColor is used to tell the routine what color to
change the fields to
'Usage: Call BlankDataControlsOnReports(Me, "Blank")

Dim ctl As Control 'Each control on the report
Dim lngI As Long 'Loop controller
Dim ctlForeColor As Long ' Color variable
' Dim subReportCTL As String

If controlColor = True Then
ctlForeColor = 16777215
ElseIf controlColor = False Then
ctlForeColor = 0
End If

For Each ctl In rpt.Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox, acListBox, acOptionGroup,
acOptionButton, acToggleButton
Debug.Print ctl.Name & " " & ctl.ControlType
'Lock/unlock these controls if bound to fields.
If HasProperty(ctl, "ControlSource") Then
If Len(ctl.ControlSource) > 0 Then 'And Not
ctl.ControlSource Like "=*"
If ctl.ForeColor <> ctlForeColor Then
ctl.ForeColor = ctlForeColor
End If
End If
End If
Case acCheckBox
Debug.Print ctl.Name & " " & ctl.ControlType & " acCheckBox"
ctl.Visible = Not controlColor
Case 112
Debug.Print ctl.Name & " " & ctl.ControlType & " acReport"
'Recursive call to handle all subreports
Debug.Print ctl.SourceObject
If Len(Nz(ctl.SourceObject, vbNullString)) > 0 Then
' subReportCTL = ctl.SourceObject
Call BlankDataControlsOnReports(ctl, controlColor)
End If

Case acLabel, acLine, acRectangle, acCommandButton, acTabCtl,
acPage, acPageBreak, acImage, acObjectFrame
'Do nothing

Case Else
'Includes acBoundObjectFrame, acCustomControl
Debug.Print ctl.Name & " " & ctl.ControlType & " not handled
" & Now()
End Select
Next

On Error Resume Next

Exit_Handler:
Set ctl = Nothing
Exit Function

Err_Handler:
MsgBox "Error " & Err.Number & " - " & Err.Description
Resume Exit_Handler
End Function

Public Function HasProperty(obj As Object, strPropName As String) As Boolean
'Purpose: Return true if the object has the property.
Dim varDummy As Variant
On Error Resume Next
varDummy = obj.Properties(strPropName)
HasProperty = (Err.Number = 0)
End Function

the problem comes up in the code:

Case 112
Debug.Print ctl.Name & " " & ctl.ControlType & " acReport"
'Recursive call to handle all subreports
Debug.Print ctl.SourceObject
If Len(Nz(ctl.SourceObject, vbNullString)) > 0 Then
' subReportCTL = ctl.SourceObject
Call BlankDataControlsOnReports(ctl, controlColor)
End If

when it trys to "jump in" to the subreport it gives the error 13 - type
mismatch. i know that this has to do with the code not really moving into the
subreport. i am just not sure how to move into the controls on the subreport.
i think i need to pass the name of the actual report that sits in the
container of the subreport. but the question is HOW? i tried to do it
earlier, but then wasnt sure where the error was and created a way to find
out what a subreport container object was as a control type. hence the 112. i
dont know what that is in the constants ("acForm", "acReport", etc) so i just
used the number that the debug.print gave me.

if anyone can help me with this it would be greatly appreciated.

 

[DawnTreader]

Hello again All

i have been trying to work this out. at this point access is telling me i am
close but no cigar...

here is my current code:

On Error GoTo Err_Handler
'Purpose: change the fore color of the bound controls and on the
reports and any of its subreports.
'Arguments rpt = the form to be changed
' controlColor is used to tell the routine what color to
change the fields to
'Usage: Call BlankDataControlsOnReports(Me, "Blank")

Dim ctl As Control 'Each control on the report
Dim lngI As Long 'Loop controller
Dim ctlForeColor As Long ' Color variable
' Dim subReportCTL As String
Dim subReportName As String
' Dim subReportrptName As Report
' Dim bla As Report


If controlColor = True Then
ctlForeColor = 16777215
ElseIf controlColor = False Then
ctlForeColor = 0
End If

For Each ctl In rpt.Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox, acListBox, acOptionGroup,
acOptionButton, acToggleButton
' Debug.Print ctl.Name & " " & ctl.ControlType & " acTextBox"
'Lock/unlock these controls if bound to fields.
If HasProperty(ctl, "ControlSource") Then
If Len(ctl.ControlSource) > 0 Then 'And Not
ctl.ControlSource Like "=*"
If ctl.ForeColor <> ctlForeColor Then
ctl.ForeColor = ctlForeColor
End If
End If
End If
Case acCheckBox
' Debug.Print ctl.Name & " " & ctl.ControlType & " acCheckBox"
ctl.Visible = Not controlColor
Case 112
Debug.Print ctl.Name & " " & ctl.ControlType & " acReport"
'Recursive call to handle all subreports
Debug.Print ctl.SourceObject
If Len(Nz(ctl.SourceObject, vbNullString)) > 0 Then
'change the ctl.sourceobject into a variable string
' subReportCTL = ctl.SourceObject
'strip the Report. off the string
subReportName = Right(subReportCTL,
(Len(ctl.SourceObject) - 7))
'show me the results
Debug.Print subReportName
'use the results
' subReportrptName = subReportName
Call BlankDataControlsOnReports(Reports(subReportName),
controlColor)
End If

Case acLabel, acLine, acRectangle, acCommandButton, acTabCtl,
acPage, acPageBreak, acImage, acObjectFrame
'Do nothing

Case Else
'Includes acBoundObjectFrame, acCustomControl
Debug.Print ctl.Name & " " & ctl.ControlType & " not handled
" & Now()
End Select
Next

On Error Resume Next

Exit_Handler:
Set ctl = Nothing
Exit Function

Err_Handler:
MsgBox "Error " & Err.Number & " - " & Err.Description
Resume Exit_Handler
End Function

Public Function HasProperty(obj As Object, strPropName As String) As Boolean
'Purpose: Return true if the object has the property.
Dim varDummy As Variant
On Error Resume Next
varDummy = obj.Properties(strPropName)
HasProperty = (Err.Number = 0)
End Function

i have tried all sorts of different things to put the name of the subreport
into the recursive part of the function. it chokes on it all the time. at
least at this point it is telling me that the report doesnt exist! (which it
does)

any and all help GREATLY appreciated.

 

[DawnTreader]

YES! I DID IT.

i thought about it some, and then realised that i can call the same code on
the subreports and forgo the recursive function.

the problem is solved.