MS Access 2007 Conditional Formatting multiple textboxes in VBA 'Procedure Too Large'
I have a report which has 73 text boxes in a row, each record that is pulled up is going to be one of 9 results, I need to color each box according to the result. I started putting together an If then Else statement referencing each box so I did
If Me!A = "0-1" Then
Me!A.ForeColor = 329171
Me!A.BackColor = 329171
ElseIf Me!A = "1-2" Then
Me!A.ForeColor = 33023
Me!A.BackColor = 33023
ElseIf Me!A = "2-3" Then
Me!A.ForeColor = 251574
Me!A.BackColor = 251574
ElseIf Me!A = "3-4" Then
Me!A.ForeColor = 16645487
Me!A.BackColor = 16645487
ElseIf Me!A = "4-5" Then
Me!A.ForeColor = 8453888
Me!A.BackColor = 8453888
ElseIf Me!A = "5-6" Then
Me!A.ForeColor = 12615680
Me!A.BackColor = 12615680
ElseIf Me!A = "6-7" Then
Me!A.ForeColor = 16744703
Me!A.BackColor = 16744703
ElseIf Me!A = "7-8" Then
Me!A.ForeColor = 65535
Me!A.BackColor = 65535
ElseIf Me!A = "8-9" Then
Me!A.ForeColor = 32896
Me!A.BackColor = 32896
Else
Me!A.ForeColor = 0
Me!A.BackColor = 16777215
End If
If Me!B = "0-1" Then
Me!B.ForeColor = 329171
Me!B.BackColor = 329171
ElseIf Me!B = "1-2" Then
Me!B.ForeColor = 33023
Me!B.BackColor = 33023
ElseIf Me!B = "2-3" Then
Me!B.ForeColor = 251574
Me!B.BackColor = 251574
ElseIf Me!B = "3-4" Then
Me!B.ForeColor = 16645487
Me!B.BackColor = 16645487
ElseIf Me!B = "4-5" Then
Me!B.ForeColor = 8453888
Me!B.BackColor = 8453888
Els开发者_JAVA百科eIf Me!B = "5-6" Then
Me!B.ForeColor = 12615680
Me!B.BackColor = 12615680
ElseIf Me!B = "6-7" Then
Me!B.ForeColor = 16744703
Me!B.BackColor = 16744703
ElseIf Me!B = "7-8" Then
Me!B.ForeColor = 65535
Me!B.BackColor = 65535
ElseIf Me!B = "8-9" Then
Me!B.ForeColor = 32896
Me!B.BackColor = 32896
Else
Me!B.ForeColor = 0
Me!B.BackColor = 16777215
End If
Etc, for each of the 73 boxes then I get the message Procedure too large. Obviously there is a lot of repetition in my code - I am totally new to this - so I wondered if there is a way to use the code once but reference all of the 73 boxes?
Store the lookup pairs in a data table, something like this:
KeyValue Foreground Background
0-1 329171 329171
1-2 33023 33023
2-3 251574 251574
3-4 16645487 16645487
4-5 8453888 8453888
5-6 12615680 12615680
6-7 16744703 16744703
7-8 65535 65535
8-9 32896 32896
Of course, now that I've edited this data in as an example, I notice that the foreground and background colors are identical, but that doesn't really affect my answer.
Now, in your code, instead of an If/Then/Else as the test to determine the color, you'd use a DLookup() to lookup the colors based on the value you were testing:
Dim lngForeColor As Long
Dim lngBackColor As Long
lngForeColor = DLookup("Foreground", "tblColors", "[KeyValue]='" & Me!A & "'")
lngBackColor = DLookup("Background", "tblColors", "[KeyValue]='" & Me!A & "'")
Me!A.ForeColor = lngForeColor
Me!A.BackColor = lngBackColor
Now, combine this with a refinement of Aaron's suggestion to loop through the controls:
Dim ctl As Control
Dim lngForeColor As Long
Dim lngBackColor As Long
For Each ctl in Me.Detail.Controls
If DCount("*", "tblColors", "[KeyValue]='" & ctl.Value & "'") = 0 Then
lngForeColor = 0
lngBackColor = 16777215
Else
lngForeColor = DLookup("Foreground", "tblColors", "[KeyValue]='" & ctl.Value & "'")
lngBackColor = DLookup("Background", "tblColors", "[KeyValue]='" & ctl.Value & "'")
End If
ctl.ForeColor = lngForeColor
ctl.BackColor = lngBackColor
Next ctl
Set ctl = Nothing
If your foreground and background colors are the same, you wouldn't need both columns in your table, and you'd only have to do one lookup.
Now, if you're not changing all the controls, just some of them, you could use the controls' .Tag property to make that conditional:
For Each ctl in Me.Detail.Controls
If .Tag = "ColorGroup" Then
' set the colors
End If
Next ctl
A better suggestion when you need to change a group of controls conditionally on data from the record is to create a custom collection and assign those controls to it in the OnOpen event of your form report. To do that, you'd create a module-level variable of type collection:
Dim colColorGroup As New Collection
In the report's OnOpen event, you'd do this:
Dim ctl As Control
For Each ctl in Me.Detail.Controls
colColorGroup.Add ctl, ctl.Name
Next ctl
Set ctl = Nothing
Then in the Format event of the detail, instead of walking the whole group of controls, you'd loop through this collection:
Dim varItem As Variant
Dim ctl As Control
For Each varItem in colColorGroup
Set ctl = varItem
If DCount("*", "tblColors", "[KeyValue]='" & ctl.Value & "'") = 0 Then
lngForeColor = 0
lngBackColor = 16777215
Else
lngForeColor = DLookup("Foreground", "tblColors", "[KeyValue]='" & ctl.Value & "'")
lngBackColor = DLookup("Background", "tblColors", "[KeyValue]='" & ctl.Value & "'")
End If
ctl.ForeColor = lngForeColor
ctl.BackColor = lngBackColor
Next varItem
Set ctl = Nothing
This will be much faster than looping through a larger group of controls and selecting based on the Tag property.
Dim ctl as control
for each ctl in me.controls
If me.controls(ctl.name).tag = "X" then me.controls(ctl.name).backcolor = ""
next ctl
精彩评论