Darryl Collins
Darryl.Collins at coles.com.au
Tue Aug 12 00:42:54 CDT 2008
Well... Turns out that I had to use the SubReports Open event to get this to work. By doing that everything seems to work fine.
'--------------------------------------
Option Compare Database
Option Explicit
Private Sub Report_Open(Cancel As Integer)
Call WriteTLM_1
End Sub
'----------------------------------------
and then run the process - which is a bit of a pain as I have 6 of these to do and I wanted to loop / case thru them in a single module, rather than having 6 code modules which are pretty much identical, but hey, go with what works... I am having to do this due to that "Cannot open any more databases" error when this report is run. This report is rather complex and was causing problems, but by writing the values into labels I get around all those pesky connection limits - and it is faster too. What I find odd is how I still refer to the Report/SubReport even though the code is being called by the Subreport open event - I would have thought a ThisReport.Something syntax would have worked in that case.
' --------------------------------------
Option Compare Database
Option Explicit
Sub WriteTLM_1()
Dim sSQL As String
Dim lFYPID As Long
Dim lAPLID As Long
Dim db As DAO.Database
Dim rsTL As DAO.Recordset
Dim rsTLClone As DAO.Recordset
Dim n As Long
' Traffic Lights as Key IDs
Dim iBudget As Integer
Dim iSched As Integer
Dim iScope As Integer
Dim iGov As Integer
Dim iStake As Integer
Dim iTeam As Integer
Dim iRisk As Integer
' Traffic Lights As Strings
Dim sBudget As String
Dim sSched As String
Dim sScope As String
Dim sGov As String
Dim sStake As String
Dim sTeam As String
Dim sRisk As String
Set db = CurrentDb
' ProgramID
lAPLID = [Forms]![frm_FYP_APLID_Admin].APLID.Value
' FY and Period ID (-1 from current period)
lFYPID = [Forms]![frm_FYP_APLID_Admin].txt1.Value
' Basic Counter
n = 0
sSQL = ""
sSQL = sSQL & "SELECT tbl_FYP_APLID.APLID, tbl_FYP_APLID.FYPID, tbl_FY_Period.FY_P, tbl_TrafficLightMatix.Budget, tbl_TrafficLightMatix.Schedule, tbl_TrafficLightMatix.Scope, tbl_TrafficLightMatix.Governance, tbl_TrafficLightMatix.Stakeholder, tbl_TrafficLightMatix.Team, tbl_TrafficLightMatix.Risk"
sSQL = sSQL & " FROM (tbl_FY_Period INNER JOIN tbl_FYP_APLID ON tbl_FY_Period.FY_P_ID = tbl_FYP_APLID.FYPID) INNER JOIN tbl_TrafficLightMatix ON tbl_FYP_APLID.FYP_APLID = tbl_TrafficLightMatix.FYP_ProgID"
sSQL = sSQL & " WHERE (((tbl_FYP_APLID.APLID)=" & lAPLID & ") AND ((tbl_FYP_APLID.FYPID)=" & lFYPID & "));"
Set rsTL = db.OpenRecordset(sSQL)
Set rsTLClone = rsTL.OpenRecordset
If (rsTLClone.RecordCount) = 0 Then
GoTo LastLine
Else
With rsTLClone
.MoveLast
.MoveFirst
End With
If (rsTLClone.RecordCount) > 0 Then
Do While Not rsTLClone.EOF
n = n + 1
If n > rsTLClone.RecordCount Then
Exit Do
End If
' Get the Traffic Light KeyID's
iBudget = rsTLClone!Budget.Value
iSched = rsTLClone!Schedule.Value
iScope = rsTLClone!Scope.Value
iGov = rsTLClone!Governance.Value
iStake = rsTLClone!Stakeholder.Value
iTeam = rsTLClone!Team.Value
iRisk = rsTLClone!Risk.Value
' Write the String Value of the Traffic Light and Colour the Label as appropriate
' Budget
If iBudget = 1 Then
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblBudget.BackColor = 8454016
sBudget = "G"
ElseIf iBudget = 2 Then
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblBudget.BackColor = 8454143
sBudget = "Y"
ElseIf iBudget = 3 Then
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblBudget.BackColor = 8421631
sBudget = "R"
Else
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblBudget.BackColor = 16777215
sBudget = ""
End If
' Schedule
If iSched = 1 Then
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblSchedule.BackColor = 8454016
sSched = "G"
ElseIf iSched = 2 Then
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblSchedule.BackColor = 8454143
sSched = "Y"
ElseIf iSched = 3 Then
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblSchedule.BackColor = 8421631
sSched = "R"
Else
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblSchedule.BackColor = 16777215
sSched = ""
End If
DoEvents
' Scope
If iScope = 1 Then
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblScope.BackColor = 8454016
sScope = "G"
ElseIf iScope = 2 Then
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblScope.BackColor = 8454143
sScope = "Y"
ElseIf iScope = 3 Then
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblScope.BackColor = 8421631
sScope = "R"
Else
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblScope.BackColor = 16777215
sScope = ""
End If
DoEvents
' Governance
If iGov = 1 Then
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblGovernance.BackColor = 8454016
sGov = "G"
ElseIf iGov = 2 Then
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblGovernance.BackColor = 8454143
sGov = "Y"
ElseIf iGov = 3 Then
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblGovernance.BackColor = 8421631
sGov = "R"
Else
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblGovernance.BackColor = 16777215
sGov = ""
End If
DoEvents
' Stake
If iStake = 1 Then
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblStakeholder.BackColor = 8454016
sStake = "G"
ElseIf iStake = 2 Then
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblStakeholder.BackColor = 8454143
sStake = "Y"
ElseIf iStake = 3 Then
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblStakeholder.BackColor = 8421631
sStake = "R"
Else
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblStakeholder.BackColor = 16777215
sStake = ""
End If
DoEvents
' Team
If iTeam = 1 Then
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblTeam.BackColor = 8454016
sTeam = "G"
ElseIf iTeam = 2 Then
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblTeam.BackColor = 8454143
sTeam = "Y"
ElseIf iTeam = 3 Then
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblTeam.BackColor = 8421631
sTeam = "R"
Else
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblTeam.BackColor = 16777215
sTeam = ""
End If
DoEvents
' Risk
If iRisk = 1 Then
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblRisk.BackColor = 8454016
sRisk = "G"
ElseIf iRisk = 2 Then
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblRisk.BackColor = 8454143
sRisk = "Y"
ElseIf iRisk = 3 Then
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblRisk.BackColor = 8421631
sRisk = "R"
Else
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].lblRisk.BackColor = 16777215
sRisk = ""
End If
DoEvents
' Write the Traffic Light Values into the Labels
With [Reports]![rpt_ProjectSummary].[rpt_TL1].[Report]
.lblBudget.Caption = sBudget
.lblSchedule.Caption = sSched
.lblScope.Caption = sScope
.lblGovernance.Caption = sGov
.lblStakeholder.Caption = sStake
.lblTeam.Caption = sTeam
.lblRisk.Caption = sRisk
End With
Loop
End If
End If
Set rsTLClone = Nothing
LastLine:
Set rsTL = Nothing
Set rsTLClone = Nothing
Set db = Nothing
End Sub
'----------------------------------------------------
----- Original Message -----
From: Darryl Collins
To: 'Access Developers discussion and problem solving'
Sent: Friday, August 08, 2008 12:00
Subject: [AccessD] Sub Report Syntax...
Hi all,
A dead easy one I am sure, but got a bad case of fried brain this friday afternoon. What is up with this syntax...
[Reports]![rpt_ProjectSummary].[rpt_TL1].[Report].Budget.Caption = sBudget
is returning "Invalide Ref to Property Form/Report", which would suggest a spelling or naming error, but I check that about 20 times already. Or do have the syntax all buggered for the subreport.
I want to write the value of the string "sBudget" into a label (named budget) on the subreport. Can be that hard surely!!??
:)
cheers
Darryl.
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com
This email and any attachments may contain privileged and confidential information
and are intended for the named addressee only. If you have received this e-mail in
error, please notify the sender and delete this e-mail immediately. Any
confidentiality, privilege or copyright is not waived or lost because this e-mail
has been sent to you in error. It is your responsibility to check this e-mail and
any attachments for viruses. No warranty is made that this material is free from
computer virus or any other defect or error. Any loss/damage incurred by using this
material is not the sender's responsibility. The sender's entire liability will be
limited to resupplying the material.
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com
This email and any attachments may contain privileged and confidential information
and are intended for the named addressee only. If you have received this e-mail in
error, please notify the sender and delete this e-mail immediately. Any
confidentiality, privilege or copyright is not waived or lost because this e-mail
has been sent to you in error. It is your responsibility to check this e-mail and
any attachments for viruses. No warranty is made that this material is free from
computer virus or any other defect or error. Any loss/damage incurred by using this
material is not the sender's responsibility. The sender's entire liability will be
limited to resupplying the material.