Контекстный поиск в поле со списком при наборе символов (Модуль Класса)

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

В целях экономии строк - простенький модуль класса.

Модуль Формы:

' -------------------------------------------------------------------------------------------------/
' Внимание !
' Свойство ComboBox(ов) .AutoExpand - должно быть = False !
' https://learn.microsoft.com/ru-ru/office/vba/api/Access.ComboBox.AutoExpand
' -------------------------------------------------------------------------------------------------/
Private colOfFormControls As New Collection  ' когда контролей несколько
'Private clsCboToFilter As clsComboBoxFAYT   ' когда контрол только один
 
Private Sub Form_Load()
Dim sDefRS$, sLookupFieldName$, blnArgsOK As Boolean
Dim ctrl As Control

'Свойство формы: https://learn.microsoft.com/ru-ru/office/vba/api/Access.Form.Cycle
    Me.Cycle = 1 ' 1 = (Только) Текущая запись

' -------------------------------------------------------------------------------------------------/
'Вариант 01 для нескольких ComboBox-ов (с Collection <colOfFormControls>) - если их более 3 шт.
' -------------------------------------------------------------------------------------------------/
    For Each ctrl In Me.Controls ' Перебор всех контролей формы
        blnArgsOK = False
        If ctrl.ControlType = acComboBox Then ' Тип контрола = ComboBox
            'Установка аргументов инициализации для каждого в отдельности
            Select Case ctrl.Name
                Case "ComboClient" ' Заказчик
                    sDefRS$ = "SELECT КодСпрКонтрагенты, НаименованиеКонтрагента FROM ТблСправочникКонтрагенты ORDER BY НаименованиеКонтрагента;"
                    sLookupFieldName = "[НаименованиеКонтрагента]"
                    blnArgsOK = True
                Case "ComboProduct" ' Изделие
                    sDefRS$ = "SELECT КодИзделия, Изделие FROM ТблСправочникИзделия ORDER BY Изделие;"
                    sLookupFieldName = "Изделие"
                    blnArgsOK = True
            End Select
            
            If blnArgsOK Then
                With New clsComboBoxFAYT
                    .Init ctrl, sDefRS, sLookupFieldName ' Инициализация
                    colOfFormControls.Add .Instance      ' Добавление в коллекцию
                End With
            End If
        End If
    Next

' -------------------------------------------------------------------------------------------------/
'Вариант 02 для нескольких ComboBox-ов (с Collection <colOfFormControls>) - если их 2-3 шт.
' -------------------------------------------------------------------------------------------------/
'    With New clsComboBoxFAYT 'ComboClient = Заказчик
'        sDefRS$ = "SELECT КодСпрКонтрагенты, НаименованиеКонтрагента FROM ТблСправочникКонтрагенты ORDER BY НаименованиеКонтрагента;"
'        .Init Me.ComboClient, sDefRS, "[НаименованиеКонтрагента]"
'        colOfFormControls.Add .Instance
'    End With
'
'    With New clsComboBoxFAYT 'ComboProduct = Изделие
'        sDefRS$ = "SELECT КодИзделия, Изделие FROM ТблСправочникИзделия ORDER BY Изделие;"
'        .Init Me.ComboProduct, sDefRS, "Изделие" ' Инициализация - Initialization of New Class Instance
'        colOfFormControls.Add .Instance          ' Добавление в коллекцию
'    End With

' -------------------------------------------------------------------------------------------------/
'Вариант 03 для одного ComboBox-а (без Collection)
' -------------------------------------------------------------------------------------------------/
'    sDefRS$ = "SELECT КодИзделия, Изделие FROM ТблСправочникИзделия ORDER BY Изделие;"
'    Set clsCboToFilter = New clsComboBoxFAYT ' Initialization of New Class Instance
'    clsCboToFilter.Init Me.ComboProduct, sDefRS, "Изделие"
' -------------------------------------------------------------------------------------------------/
End Sub

Private Sub Form_Unload(Cancel As Integer)
' Class and Collection Destroying on closing the Form
    'Set clsCboToFilter = Nothing
    Set colOfFormControls = Nothing
End Sub

Модуль Класса:

' -------------------------------------------------------------------------------------------------/
' Name: clsComboBoxFAYT
' Kind: Class Module
' Purpose: Filter as you type (FAYT) in ComboBox (Простенько)
' Author: es
' Date: 05.08.2024 LE 06.08.2024 v002
' -------------------------------------------------------------------------------------------------/
' v001 : 05.08.2024 : https://www.cyberforum.ru/ms-access/thread3175844.html#post17371257
' -------------------------------------------------------------------------------------------------/
Option Compare Database
Option Explicit

Private WithEvents ctrlWEComboBox As ComboBox
Private sComboBoxText$
Private sDefRowSource$, sLookupField$, sSQLSelectString$, sSQLOrderByString$ 

Public Sub Init(ctrlComboBox As ComboBox, sDefaultRowSource As String, sLookupFieldName As String)
' Инициализация класса - исполняется на Form_Load()
Dim iVal%
Const csEP$ = "[Event Procedure]"
    
    Set ctrlWEComboBox = ctrlComboBox
    sDefRowSource = Replace(sDefaultRowSource, ";", "")    ' Удаление точки с запятой
    sLookupField = sLookupFieldName
    
    iVal = InStr(sDefRowSource, "ORDER BY")
    If iVal > 0 Then ' Порядок сортировки указан
        sSQLSelectString = Mid(sDefRowSource, 1, iVal - 2) ' Часть SELECT ...
        sSQLOrderByString = Mid(sDefRowSource, iVal)       ' Часть ORDER BY ...
    Else
        sSQLSelectString = sDefRowSource
        sSQLOrderByString = ""
    End If
    
    With ctrlWEComboBox
        .OnKeyDown = csEP
        .OnChange = csEP
        .OnKeyUp = csEP
        .AfterUpdate = csEP
        .OnLostFocus = csEP
        
        .LimitToList = True
        .AutoExpand = False
        
    End With
End Sub

Public Property Get Instance() As clsComboBoxFAYT 'Instance of a Class
'Сылка на экземпляр класса - Только для заполнения коллекции, иначе не нужно
    Set Instance = Me
End Property

Private Sub ctrlWEComboBox_KeyDown(KeyCode As Integer, Shift As Integer)
    'Debug.Print "KeyDown > KeyCode:" & KeyCode
    If KeyCode = vbKeyDelete Then
        sComboBoxText = Mid(ctrlWEComboBox.Text, 1, ctrlWEComboBox.SelStart)
        ReFilterComboBox
    End If
End Sub

Private Sub ctrlWEComboBox_Change()
    sComboBoxText = Trim(ctrlWEComboBox.Text)
'    Debug.Print "Change() > sComboBoxText: [" & sComboBoxText & "]"
End Sub

Private Sub ReFilterComboBox()
Dim sNewRowSouce$, sVal$, iVal%

    If Len(sComboBoxText) > 0 Then 'Если текст в контроле длиннее 0 символов
        sVal = " WHERE " & sLookupField & " LIKE '*" & sComboBoxText & "*'"
        sNewRowSouce = sSQLSelectString & sVal & sSQLOrderByString
    Else
        sVal = "Применён RowSource по умолчанию (без фильтра)."
        sNewRowSouce = sDefRowSource    'Default row source
    End If

'Report!
    ctrlWEComboBox.Parent.TextReport = sVal
    
    If ctrlWEComboBox.RowSource <> sNewRowSouce Then 'Фильтр изменился
        ctrlWEComboBox.RowSource = sNewRowSouce
        If Len(sComboBoxText) > 0 Then ctrlWEComboBox.Dropdown ' ???
        'Debug.Print "New RS: " & sNewRowSouce
    End If
End Sub

Private Sub ctrlWEComboBox_KeyUp(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyUp, vbKeyDown ' Перемещение по списку
        Case vbKeyReturn        ' Клавиша [Enter]
        Case Else: ReFilterComboBox
    End Select
End Sub

Private Sub ctrlWEComboBox_AfterUpdate()
    sComboBoxText = ""
    ctrlWEComboBox.Parent.TextReport = "Значение Установлено" 'Report!
End Sub

Private Sub ctrlWEComboBox_LostFocus()
    Call FRMControlFocusInOut(ctrlWEComboBox.Parent.Name, 0) ' Подсветка активного поля в форме = OFF
    ctrlWEComboBox.RowSource = sDefRowSource
    ctrlWEComboBox.Parent.TextReport = Null 'Report!
End Sub

MSA-2000 и выше ( 77 kB) Пример