Список FormatConditions всех элементов управления в форме доступа - PullRequest
0 голосов
/ 09 февраля 2020

Можно ли перечислить условное форматирование всех элементов управления в форме? Я хотел бы иметь возможность перечислить все существующие условия, чтобы я мог генерировать код для добавления / удаления существующих условий. Я унаследовал некоторые сложные формы и хочу знать, с чем я имею дело, а затем сгенерировать некоторый код для переключения условного форматирования в областях, где он замедляет навигацию по непрерывной форме.

В этом примере Excel VBA показан аналогичный формат, который я хотел бы иметь для доступа.
{ ссылка }

Ответы [ 2 ]

0 голосов
/ 10 февраля 2020

С вдохновением из примера @ June7 и кода из статьи , которую я нашел Гарри Робинсоном, я написал процедуру, которая отвечает на мой вопрос.

Вот вывод в окне Immediate , Это готово для вставки в модуль.

txtRowColor.FormatConditions.Delete
txtRowColor.FormatConditions.Add acExpression, acBetween, "[txtCurrent_Equipment_List_ID]=[txtEquipment_List_ID]"
With txtRowColor.FormatConditions.Item(txtRowColor.FormatConditions.Count-1)
    .Enabled          = True           ' txtRowColor.Enabled=False
    .ForeColor        = 0              ' txtRowColor.ForeColor=-2147483640
    .BackColor        = 10092543       ' txtRowColor.BackColor=11850710
End With

Вы можете проверить эту подпрограмму из события щелчка на открытой форме. Я получал некоторые ложные срабатывания при проверке логического свойства .Enabled, даже когда я сначала сохранял значения в логических переменных. Я не знаю почему и исследую это, но это выходит за рамки этого вопроса.

Public Sub ListConditionalFormats(frmForm As Form)
' Show all the Textbox and Combobox controls on the past form object (assuming the form is open).
' Output the FormatCondtion properties to the immediate window in a format that is
' suitable to be copied into VBA to recreate the conditional formatting.

    Dim ctl             As Control
    Dim i               As Integer
    Dim bolControlEnabled As Boolean
    Dim bolFormatEnabled As Boolean

    On Error GoTo ErrorHandler

    For Each ctl In frmForm.Controls

        If TypeOf ctl Is TextBox Or TypeOf ctl Is ComboBox Then
            With ctl
                If .FormatConditions.Count > 0 Then
                    'Debug.Print vbCr & "' " & ctl.Name, "Count = " & .FormatConditions.Count
                    For i = 0 To .FormatConditions.Count - 1

                        ' Generate code that can recreate each FormatCondition
                        Debug.Print ctl.Name & ".FormatConditions.Delete"
                        Debug.Print ctl.Name & ".FormatConditions.Add " & DecodeType(.FormatConditions(i).Type) _
                                    & ", " & DecodeOp(.FormatConditions(i).Operator) _
                                    & ", """ & .FormatConditions(i).Expression1 & """" _
                                    & IIf(Len(.FormatConditions(i).Expression2) > 0, ", " & .FormatConditions(i).Expression2, "")
                        Debug.Print "With " & ctl.Name & ".FormatConditions.Item(" & ctl.Name & ".FormatConditions.Count-1)"

                        bolControlEnabled = ctl.Enabled
                        bolFormatEnabled = .FormatConditions(i).Enabled
                        'Debug.Print bolControlEnabled <> bolFormatEnabled, bolControlEnabled, bolFormatEnabled
                        If bolControlEnabled <> bolFormatEnabled Then    ' <- This sometimes fails.  BS 2/9/2020
                            'If ctl.Enabled <> .FormatConditions(i).Enabled Then ' <- This sometimes fails.  BS 2/9/2020
                            Debug.Print vbTab & ".Enabled          = " & .FormatConditions(i).Enabled; Tab(40); "' " & ctl.Name & ".Enabled=" & ctl.Enabled
                        End If

                        If ctl.ForeColor <> .FormatConditions(i).ForeColor Then
                            Debug.Print vbTab & ".ForeColor        = " & .FormatConditions(i).ForeColor; Tab(40); "' " & ctl.Name & ".ForeColor=" & ctl.ForeColor
                        End If
                        If ctl.BackColor <> .FormatConditions(i).BackColor Then
                            Debug.Print vbTab & ".BackColor        = " & .FormatConditions(i).BackColor; Tab(40); "' " & ctl.Name & ".BackColor=" & ctl.BackColor
                        End If
                        If ctl.FontBold <> .FormatConditions(i).FontBold Then
                            Debug.Print vbTab & ".FontBold         = " & .FormatConditions(i).FontBold; Tab(40); "' " & ctl.Name & ".FontBold=" & ctl.FontBold
                        End If
                        If ctl.FontItalic <> .FormatConditions(i).FontItalic Then
                            Debug.Print vbTab & ".FontItalic       = " & .FormatConditions(i).FontItalic; Tab(40); "' " & ctl.Name & ".FontItalic=" & ctl.FontItalic
                        End If
                        If ctl.FontUnderline <> .FormatConditions(i).FontUnderline Then
                            Debug.Print vbTab & ".FontUnderline    = " & .FormatConditions(i).FontUnderline; Tab(40); "' " & ctl.Name & ".FontUnderline=" & ctl.FontUnderline
                        End If

                        If .FormatConditions(i).Type = 3 Then    ' acDataBar
                            Debug.Print vbTab & ".LongestBarLimit  = " & .FormatConditions(i).LongestBarLimit
                            Debug.Print vbTab & ".LongestBarValue  = " & .FormatConditions(i).LongestBarValue
                            Debug.Print vbTab & ".ShortestBarLimit = " & .FormatConditions(i).ShortestBarLimit
                            Debug.Print vbTab & ".ShortestBarValue = " & .FormatConditions(i).ShortestBarValue
                            Debug.Print vbTab & ".ShowBarOnly      = " & .FormatConditions(i).ShowBarOnly
                        End If
                        Debug.Print "End With" & vbCr
                    Next
                End If
            End With
        End If
    Next

    Beep

Exit_Sub:
    Exit Sub

ErrorHandler:
    MsgBox "Error #" & Err.Number & " - " & Err.Description & vbCrLf & "in procedure ListConditionalFormats" _
        & IIf(Erl > 0, vbCrLf & "Line #: " & Erl, "")
    GoTo Exit_Sub
    Resume Next
    Resume
End Sub

Function DecodeType(TypeProp As Integer) As String
' You heed this are there are 4 different ways to setup a CondtionalFormat
' https://vb123.com/listing-conditional-formats

    Select Case TypeProp
        Case 0
            DecodeType = "acFieldValue"
        Case 1
            DecodeType = "acExpression"
        Case 2
            DecodeType = "acFieldHasFocus"
        Case 3
            DecodeType = "acDataBar"
    End Select

End Function

Function DecodeOp(OpProp As Integer) As String
' You need this becuase equations can comprise of = > <> between
' https://vb123.com/listing-conditional-formats

    Select Case OpProp
        Case 0
            DecodeOp = "acBetween"
        Case 1
            DecodeOp = "acNotBetween"
        Case 2
            DecodeOp = "acEqual"
        Case 3
            DecodeOp = "acNotEqual"
        Case 4
            DecodeOp = "acGreaterThan"
        Case 5
            DecodeOp = "acLessThan"
        Case 6
            DecodeOp = "acGreaterThanOrEqual"
        Case 7
            DecodeOp = "acLessThanOrEqual"
    End Select

End Function
0 голосов
/ 09 февраля 2020

Условное форматирование имеют только текстовые поля и комбинированные списки.

Нет ни одного свойства, которое может быть указано в списке для отображения правила (ов) условного форматирования элемента управления. Каждое правило имеет атрибуты, которые могут быть перечислены. Пример перечисления для отдельного заданного c элемента управления:

Private Sub Command25_Click()
Dim x As Integer
With Me.tbxRate
For x = 0 To .FormatConditions.Count - 1
    Debug.Print .FormatConditions(x).BackColor
    Debug.Print .FormatConditions(x).Expression1
    Debug.Print .FormatConditions(x).FontBold
Next
End With
End Sub

Вывод для этого примера:

 2366701 
20
False

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

Да, код может l oop с помощью элементов управления в форме, проверить типы текстовых полей и комбинированных списков, определить, существуют ли правила CF и выходные атрибуты.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...