Need help -
I currently have a list box that is populated via SQL staement attached to the rowsource. Depending on the value of the the row in the list box, i need the color of the font to change. The following code is close but is applying the forecolor to to the whole list box - not just the individual rows.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Public Function funLstDeliverable()
Dim conn As ADODB.Connection
Dim rsDeliverable As ADODB.Recordset
Dim strSQL As String
Dim strDeliverable
Dim intPhaseData As Integer
Dim lngEstimate As Long
Dim lngTotal As Long
Dim intCount As Integer
lstDeliverable.Enabled = True
strSQL = "SELECT DISTINCT [tblEstimates].[pkEstimateID], [tblPhase].[fldPhase], [tblDeliverables].[pkDeliverableID], [tblDeliverables].[fldDeliverable], [tblEstimates].[fldEstimate], [tblEstimates].[fldStart], [tblEstimates].[fldFinish], [tblEstimates].[fldLastActual], [tblEstimates].[fldTotalActual]"
strSQL = strSQL & " FROM tblPhase INNER JOIN (tblDeliverables INNER JOIN tblEstimates ON [tblDeliverables].[pkDeliverableID]=[tblEstimates].[fldDeliverablesID]) ON [tblPhase].[pkPhaseID]=[tblDeliverables].[fldPhaseID]"
strSQL = strSQL & " WHERE [tblPhase].[pkPhaseID]= " & lstPhase.ItemData(lstPhase.ListIndex) & " AND tblEstimates.fldProjectID=" & gProjID
'Set ADO connection
Set conn = CurrentProject.Connection
Set rsDeliverable = New ADODB.Recordset
'Open tables
rsDeliverable.Open strSQL, CurrentProject.Connection
intCount = 0
While Not rsDeliverable.EOF
lstDeliverable.RowSource = strSQL
lngEstimate = rsDeliverable("fldEstimate"
lngTotal = rsDeliverable("fldTotalActual"
'MsgBox "est = " & intEstimate & " Tot = " & intTotal
' If lngEstimate > lngTotal Then
' lstDeliverable.ForeColor = 8453888 'green
' ElseIf lngEstimate < lngTotal Then
' lstDeliverable.ForeColor = 255 'red
' End If
' intCount = intCount + 1
rsDeliverable.MoveNext
Wend
""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
I currently have a list box that is populated via SQL staement attached to the rowsource. Depending on the value of the the row in the list box, i need the color of the font to change. The following code is close but is applying the forecolor to to the whole list box - not just the individual rows.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Public Function funLstDeliverable()
Dim conn As ADODB.Connection
Dim rsDeliverable As ADODB.Recordset
Dim strSQL As String
Dim strDeliverable
Dim intPhaseData As Integer
Dim lngEstimate As Long
Dim lngTotal As Long
Dim intCount As Integer
lstDeliverable.Enabled = True
strSQL = "SELECT DISTINCT [tblEstimates].[pkEstimateID], [tblPhase].[fldPhase], [tblDeliverables].[pkDeliverableID], [tblDeliverables].[fldDeliverable], [tblEstimates].[fldEstimate], [tblEstimates].[fldStart], [tblEstimates].[fldFinish], [tblEstimates].[fldLastActual], [tblEstimates].[fldTotalActual]"
strSQL = strSQL & " FROM tblPhase INNER JOIN (tblDeliverables INNER JOIN tblEstimates ON [tblDeliverables].[pkDeliverableID]=[tblEstimates].[fldDeliverablesID]) ON [tblPhase].[pkPhaseID]=[tblDeliverables].[fldPhaseID]"
strSQL = strSQL & " WHERE [tblPhase].[pkPhaseID]= " & lstPhase.ItemData(lstPhase.ListIndex) & " AND tblEstimates.fldProjectID=" & gProjID
'Set ADO connection
Set conn = CurrentProject.Connection
Set rsDeliverable = New ADODB.Recordset
'Open tables
rsDeliverable.Open strSQL, CurrentProject.Connection
intCount = 0
While Not rsDeliverable.EOF
lstDeliverable.RowSource = strSQL
lngEstimate = rsDeliverable("fldEstimate"
lngTotal = rsDeliverable("fldTotalActual"
'MsgBox "est = " & intEstimate & " Tot = " & intTotal
' If lngEstimate > lngTotal Then
' lstDeliverable.ForeColor = 8453888 'green
' ElseIf lngEstimate < lngTotal Then
' lstDeliverable.ForeColor = 255 'red
' End If
' intCount = intCount + 1
rsDeliverable.MoveNext
Wend
""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""