Code for multiple items

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?
 
D

Douglas J. Steele

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
 
G

Guest

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
 
D

Douglas J. Steele

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
 
G

Guest

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.
 
D

Douglas J. Steele

Sorry: I missed the fact you were referring to the control again.

Glad you got it working.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top