Help with Data Bar

Pisteuo

Registered User.
Local time
Today, 08:59
Joined
Jul 12, 2009
Messages
72
I am using Access 2007 and I found that Access 2010 provides data bars as a conditional formatting option. I found the following code for applying data bars.

I am attempting to apply the data bar against a control in a continuous report, but it is not working. The code does not error, but my label formats do not change.

The function found online. I added two labels (baselbl and lblMeter) to my report:

Code:
Public Function PctMeter(vAmt As Variant, vTotal As Variant)
    Dim sngPct As Single

    On Error GoTo PctMeter_Error

    sngPct = vAmt / vTotal

    If sngPct <= 1 Then
        Me!baselbl.Caption = Int(sngPct * 100) & "%"
        Me!lblMeter.Width = CLng(Me!baselbl.Width * sngPct)
    Else
        Me!baselbl.Caption = "Greater than 100% - Check your amounts"
        Me!lblMeter.Width = CLng(Me!baselbl.Width * 1)
    End If

    Me!lblMeter.BackColor = 16711680

    Select Case sngPct    'change the caption font color to white if greater than 50%
    Case Is < 0.5
        Me!baselbl.ForeColor = 0
    Case Else
        Me!baselbl.ForeColor = 16777215
    End Select
    Me.Repaint


PctMeter_Exit:
    Exit Function

PctMeter_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure PctMeter of VBA Document Form_frmProgressBar"
    Resume PctMeter_Exit
End Function

My calling code:
Private Sub Report_Load()

On Error GoTo Err_Report

Dim MyvAmt As Variant
Dim MyvTotal As Variant

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("qryPROJECTExpenditureForecastTABLE", dbOpenDynaset)


MyvTotal = DSum("[fldABSVarianceMONTH]", "qryPROJECTExpenditureForecastTABLE")

If Not (rs.BOF And rs.EOF) Then
If rs.RecordCount <> 0 Then

Do While Not rs.EOF
If rs![fldABSVarianceMONTH] <> Something Then
Exit Do
End If
MyvAmt = rs![fldABSVarianceMONTH]
Call PctMeter(MyvAmt, MyvTotal)
rs.MoveNext
Loop
End If
End If

rs.Close

Exit_Report:
Set rs = Nothing
Set db = Nothing
Exit Sub

Err_Report:
Resume Exit_Report

End Sub

Thank you for the help.
 

Users who are viewing this thread

Back
Top Bottom