VBA, MS Access MS Access в примерах

Поле со Списком (ComboBox) - Зависимые (связанные) списки - Упрощение ввода данных (+ Пример)

По материалам: https://www.cyberforum.ru/ms-access/thread2769742.html

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

Option Compare Database
Option Explicit
Private Const RSComboA02$ = "SELECT [ID Cons], [Индекс ячейки], [Индекс щита] " & _
                            "FROM Consumers WHERE True ORDER BY [Индекс ячейки]"
Private Const RSComboB02$ = "SELECT Тип, Номинал, Производитель, [Каталожный номер], " & _
                            "[Вид оборудования] FROM [Parameters Of Equipments] WHERE True"
Private Sub ComboA01LayoutDB_AfterUpdate()
    RefreshComboBoxes "ComboA01LayoutDB"
End Sub

Private Sub ComboA02Consumers_AfterUpdate()
   Me!TextA02Consumers = Me!ComboA02Consumers.Column(2)
End Sub
Private Sub ComboB01Equipments_AfterUpdate()
    RefreshComboBoxes "ComboB01Equipments"
End Sub
Private Sub RefreshComboBoxes(sCboxName$)
Dim sVal$, sRowSource$
Dim sSubCombo$, sSubText$
    Select Case sCboxName
        Case "ComboA01LayoutDB"
        'A1
            If Me(sCboxName).ListIndex > -1 Then 'выбрано значение из списка
                sVal = "WHERE [Индекс Щита] = '" & Me!ComboA01LayoutDB & "'"
                sRowSource = Replace(RSComboA02, "WHERE True", sVal)
            Else
                sRowSource = RSComboA02
            End If
            sSubCombo = "ComboA02Consumers"
            sSubText = "TextA02Consumers"
        'B1
        Case "ComboB01Equipments"
            If Me(sCboxName).ListIndex > -1 Then 'выбрано значение из списка
                sVal = " WHERE [Вид оборудования] = '" & Me!ComboB01Equipments & "'"
                sRowSource = Replace(RSComboB02, "WHERE True", sVal)
            Else
                sRowSource = RSComboB02
            End If
            sSubCombo = "ComboB02ParametersOfEquipments"
            sSubText = "TextB02ParametersOfEquipments"
    End Select

'Фильтрация списка
    Me(sSubCombo).RowSource = sRowSource
    Me(sSubCombo).Requery

'Зачистка если не попадает под условия
    If Me(sSubCombo).ListIndex = -1 Then
        Me(sSubCombo) = Null
        Me(sSubText) = Null
    End If
End Sub

Private Sub ComboB02ParametersOfEquipments_AfterUpdate()
    Me!TextB02ParametersOfEquipments = Me!ComboB02ParametersOfEquipments.Column(4)
End Sub

Private Sub Form_Current()
Dim vVal, sVal$
    
'Зануление несвязанных полей
    Me!ComboA01LayoutDB = Null
    Me!TextA02Consumers = Null
    Me!ComboB01Equipments = Null
    Me!TextB02ParametersOfEquipments = Null

'Восстановление исходнвх источников списков (после возм. прошлых фильтраций)
    Me!ComboA02Consumers.RowSource = RSComboA02
    Me!ComboB02ParametersOfEquipments.RowSource = RSComboB02

'ComboA02Consumers - Определяем значение Parent списка
    If IsNull(Me!ComboA02Consumers) = False Then
        sVal = "[ID Cons] = " & Me!ComboA02Consumers
        vVal = DLookup("[Индекс Щита]", "Consumers", sVal)
        Me!ComboA01LayoutDB = vVal
        Me!TextA02Consumers = vVal
    Else
        Me!ComboA01LayoutDB = Null
        Me!TextA02Consumers = Null
    End If
    RefreshComboBoxes "ComboA01LayoutDB"

'ComboB02ParametersOfEquipments - Определяем значение Parent списка
    If IsNull(Me!ComboB02ParametersOfEquipments) = False Then
        sVal = "[Тип] = '" & Me!ComboB02ParametersOfEquipments & "'"
        vVal = DLookup("[Вид оборудования]", "[Parameters Of Equipments]", sVal)
        Me!ComboB01Equipments = vVal
        Me!TextB02ParametersOfEquipments = vVal
    Else
        Me!ComboB01Equipments = Null
        Me!TextB02ParametersOfEquipments = Null
    End If
    RefreshComboBoxes "ComboB01Equipments"

End Sub


Picture

Picture




Скачать

MSA-2003 ( 44 kB) Пример


Назад ToTop
L.E. 29.08.2022
Рейтинг@Mail.ru