MS Access 2007 Условное форматирование нескольких текстовых полей в VBA «Слишком большая процедура» - PullRequest
0 голосов
/ 13 января 2011

У меня есть отчет, который содержит 73 текстовых поля подряд, каждая извлекаемая запись будет одним из 9 результатов, мне нужно покрасить каждое поле в соответствии с результатом. Я начал собирать оператор If затем Else, ссылающийся на каждое поле, поэтому я сделал

    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
    ElseIf 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 

И т.д., для каждого из 73 полей я получаю сообщение Процедура слишком большая. Очевидно, в моем коде много повторений - я совершенно новичок в этом - поэтому я подумал, есть ли способ использовать код один раз, но ссылаться на все 73 блока?

Ответы [ 2 ]

1 голос
/ 15 января 2011

Сохраните пары поиска в таблице данных, что-то вроде этого:

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

Конечно, теперь, когда я отредактировал эти данные в качестве примера, я заметил, что цвета переднего плана и фонаидентично, но это не влияет на мой ответ.

Теперь в вашем коде вместо If / Then / Else в качестве теста для определения цвета вы будете использовать DLookup () для поиска цветов на основе значения, которое вы тестировали:

  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

Теперь, объедините это с уточнением предложения Аарона обойти все элементы управления:

  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

Если ваш цвет переднего плана и фона одинаковы, вам не понадобятся оба столбца вваш стол, и вам нужно будет сделать только один поиск.

Теперь, если вы не меняете все элементы управления, а только некоторые из них, вы можете использовать свойство .Tag элементов управления, чтобы сделать это условным:

  For Each ctl in Me.Detail.Controls
    If .Tag = "ColorGroup" Then
       ' set the colors
    End If
  Next ctl

Лучшее предложение, когдавам нужно изменить группу элементов управления условно на основе данных из записи, чтобы создать пользовательскую коллекцию и назначить эти элементы управления ей в событии OnOpen вашего отчета формы.Для этого вы должны создать переменную уровня модуля типа collection:

  Dim colColorGroup As New Collection

В событии OnOpen отчета вы должны сделать следующее:

  Dim ctl As Control

  For Each ctl in Me.Detail.Controls
    colColorGroup.Add ctl, ctl.Name   
  Next ctl
  Set ctl = Nothing

Затем вОтформатируйте событие детализации, вместо того чтобы проходить всю группу элементов управления, вы будете циклически проходить через эту коллекцию:

  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

Это будет намного быстрее, чем циклически проходить большую группу элементов управления и выбирать на основеСвойство тега.

1 голос
/ 14 января 2011
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
...