开发者

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
0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜