Code for multiple items

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I have a progress bar on a form, but I want about 15 more of them. Each one
accesses 2 different field values, looked up using a domain function. The
part of code in the function that I need help with is here:

sngPct = varAmt / varTotal
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

How can I change this so it runs for all 15 objects instead of copying the
whole function for each object? (baselbl1 and lblmeter1 thru baselbl15 and
lblmeter15) Use a select case for each item?
 
Assuming varAmt and varTotal are each 15 element arrays:

For intLoop = 1 To 15
sngPct = varAmt(intLoop) / varTotal(intLoop)
If sngPct <= 1 Then
Me.Controls("baselbl" & intLoop).Caption = _
Int(sngPct * 100) & "%"
Me.Controls("lblmeter" & intLoop).Width = _
CLng(Me!baselbl.Width * sngPct)
Else
Me.Controls("baselbl" & intLoop).Caption = _
"Greater than 100% - Check your amounts"
Me.Controls("lblmeter" & intLoop).Width = _
CLng(Me!baselbl.Width * 1)
End If
Next intLoop
 
and if they're not arrays? It wouldn't let me define an array in the
function statement: Public Function PctMeter(varAmt As Variant, varTotal As
Variant)
I tried Public Function PctMeter(varAmt(1 to 15) As Variant, varTotal(1 to
15) As Variant) Here's the whole function:

Public Function PctMeter(varAmt As Variant, varTotal As Variant)
Dim sngPct As Single

sngPct = varAmt / varTotal
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

Select Case sngPct
Case Is < 0.15
Me!lblmeter.BackColor = 255
Case Is < 0.7
Me!lblmeter.BackColor = 65535
Case Else
Me!lblmeter.BackColor = 65280
End Select
End Function

and the calling statement:

Private Sub txt4_AfterUpdate()
If Not IsNull(Me.Txt4) And Not IsNull(Me.Txt2) Then
Call PctMeter(Me.Txt2, Me.Txt4)
End If
End Sub
 
Change your function to accept varAmt, varTotal and ControlNumber, where
ControlNumber will be a value between 1 and 15 indicating which progress bar
you want to use.

Public Function PctMeter(varAmt As Variant, varTotal As Variant,
ControlNumber As Integer)
Dim sngPct As Single

If ControlNumber >= 1 And ControlNumber <= 15 Then
sngPct = varAmt / varTotal
If sngPct <= 1 Then
Me.Controls("baselbl" & ControlNumber).Caption = _
Int(sngPct * 100) & "%"
Me.Controls("lblmeter" & ControlNumber).Width = _
CLng(Me!baselbl.Width * sngPct)
Else
Me.Controls("baselbl" & ControlNumber).Caption = _
"Greater than 100% - Check your amounts"
Me.Controls("lblmeter" & ControlNumber).Width = _
CLng(Me!baselbl.Width * 1)
End If

With Me.Controls("lblmeter" & ControlNumber)
Select Case sngPct
Case Is < 0.15
.BackColor = 255
Case Is < 0.7
.BackColor = 65535
Case Else
.BackColor = 65280
End Select
End With
End If
End Function

You should probably also have a check in there to ensure varTotal isn't 0.


--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)


Maarkr said:
and if they're not arrays? It wouldn't let me define an array in the
function statement: Public Function PctMeter(varAmt As Variant, varTotal
As
Variant)
I tried Public Function PctMeter(varAmt(1 to 15) As Variant, varTotal(1 to
15) As Variant) Here's the whole function:

Public Function PctMeter(varAmt As Variant, varTotal As Variant)
Dim sngPct As Single

sngPct = varAmt / varTotal
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

Select Case sngPct
Case Is < 0.15
Me!lblmeter.BackColor = 255
Case Is < 0.7
Me!lblmeter.BackColor = 65535
Case Else
Me!lblmeter.BackColor = 65280
End Select
End Function

and the calling statement:

Private Sub txt4_AfterUpdate()
If Not IsNull(Me.Txt4) And Not IsNull(Me.Txt2) Then
Call PctMeter(Me.Txt2, Me.Txt4)
End If
End Sub
Click to expand...
 
just needed to adjust the right half of some statements to account for the
control number...thanks

If ControlNumber >= 1 And ControlNumber <= 15 Then
sngPct = varAmt / varTotal
If sngPct <= 1 Then
Me.Controls("baselbl" & ControlNumber).Caption = Int(sngPct * 100) &
"%"
Me.Controls("lblmeter" & ControlNumber).Width =
CLng(Me.Controls("baselbl" & ControlNumber).Width * sngPct)
Else
Me.Controls("baselbl" & ControlNumber).Caption = "Greater than 100%
- Check your amounts"
Me.Controls("lblmeter" & ControlNumber).Width =
CLng(Me.Controls("baselbl" & ControlNumber).Width * 1)
End If


Douglas J. Steele said:
Change your function to accept varAmt, varTotal and ControlNumber, where
ControlNumber will be a value between 1 and 15 indicating which progress bar
you want to use.

Public Function PctMeter(varAmt As Variant, varTotal As Variant,
ControlNumber As Integer)
Dim sngPct As Single

If ControlNumber >= 1 And ControlNumber <= 15 Then
sngPct = varAmt / varTotal
If sngPct <= 1 Then
Me.Controls("baselbl" & ControlNumber).Caption = _
Int(sngPct * 100) & "%"
Me.Controls("lblmeter" & ControlNumber).Width = _
CLng(Me!baselbl.Width * sngPct)
Else
Me.Controls("baselbl" & ControlNumber).Caption = _
"Greater than 100% - Check your amounts"
Me.Controls("lblmeter" & ControlNumber).Width = _
CLng(Me!baselbl.Width * 1)
End If

With Me.Controls("lblmeter" & ControlNumber)
Select Case sngPct
Case Is < 0.15
.BackColor = 255
Case Is < 0.7
.BackColor = 65535
Case Else
.BackColor = 65280
End Select
End With
End If
End Function

You should probably also have a check in there to ensure varTotal isn't 0.
Click to expand...
 
Sorry: I missed the fact you were referring to the control again.

Glad you got it working.
 
Back
Top