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

Поле со Списком (ComboBox) - Фильтрация списка по введённому значению


Лучше сразу установить Property: ComboBox.AutoExpand = False


Private Sub cbxGoodID_Change()
' es 22.03.2019
' Фильтрация поля со списком (ComboBox) по введённому произвольному значению
'--------------------------------------------------------------------------
Dim f$, s$
On Error GoTo cbxGoodID_Change_Err
    If Me!cbxGoodID.ListIndex = -1 Then 'Указанного в поле значения нет в списке ...
        'Работаем:
        f = Me!cbxGoodID.Text
        f = LTrim(f) ' убрали пробелы перед строкой (если были), но не после
        'Любой пробел между введённым - воспринимать как любую последовательность символов ...
        f = Replace(f, " ", "*") ' не обязательно - это "на любителя" - мне нравиться так
        'Если есть что то введённое:
        If Len(f) > 0 Then
            'Фильтрация:
            s = "SELECT Good_ID, Chr(9) & gdsName FROM tblGoods " & _
                "WHERE Chr(9) & gdsName like '*" & f & "*' ORDER BY gdsName"
        Else
            'Исходное состояние - значения в поле нет
            s = "SELECT Good_ID, Chr(9) & gdsName FROM tblGoods ORDER BY gdsName"
        End If
    Else
        'Выбрано значение из списка - Готово!
        GoTo cbxGoodID_Change_End ' на выход!
    End If
    
    Me!cbxGoodID.RowSource = s 'Применяем новый источник записей
    
    Me!cbxGoodID.SelStart = Len(Me!cbxGoodID.Text) ' Курсор в конец текста
    Me!cbxGoodID.SelLength = 0     ' Выделенный текст = 0 символов
    
    Me!cbxGoodID.Dropdown 'Разворот списка

cbxGoodID_Change_End:
    Exit Sub

cbxGoodID_Change_Err:
    MsgBox "Error: " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in Sub: cbxGoodID_Change", vbCritical, "Error in Application"
    Err.Clear
    Resume cbxGoodID_Change_End

End Sub
'--------------------------------------------------------------------------
' Дополнительно и обязательно - отмена фильтра при получении фокуса
'--------------------------------------------------------------------------

Private Sub cbxGoodID_GotFocus()
' Получение фокуса полем со списком
Dim s$
    'Авто подстановку лучше вырубить - мы отбираем сами (по своему)
    Me!cbxGoodID.AutoExpand = False
    
    'Приводим в исходное состояние (перед новым вводом и поиском)
    s = "SELECT Good_ID, Chr(9) & gdsName FROM tblGoods ORDER BY gdsName" ' DESC
    Me!cbxGoodID.RowSource = s
End Sub

'--------------------------------------------------------------------------
' Дополнительно и обязательно - В исходное при потере фокуса
'--------------------------------------------------------------------------
Private Sub cbxGoodID_LostFocus()
'Потеря фокуса ...
Dim s$
    'Приводим в исходное состояние (ИЗНАЧАЛЬНОЕ! и верное.
    s = "SELECT Good_ID, gdsName FROM tblGoods ORDER BY gdsName" ' DESC
    Me!cbxGoodID.RowSource = s
End Sub

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