Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Microsoft Access Новый топик    Ответить
 Автофильтрующийся комбобокс  [new]
iKaRus
Member

Откуда:
Сообщений: 34
Список фильтруется по мере ввода данных.
Удобно использовать на более менее длинных списках.
Класс взят как есть из рабочего проекта. Делалось под свои задачи, но пока особых проблем за ним не замечал. Последний раз дорабатывалось когда понадобилось расширить функционал на простые списки.
Во время написания поста нашел похожую тему: [url=]https://www.sql.ru/forum/277809/filtraciya-combobox-po-mere-vneseniya-dannyh-ado?mid=2510813#2510813[/url]
В общем,- может кому пригодится и моя поделка на эту тему..
Конструктивная критика приветствуется.
Option Compare Database
Option Explicit
'=========================
Private Const c_strModule As String = "clsAutoFilteredCombo"
'=========================
' Описание      : Класс для работы с автофильтрующимися комбобоксами.
' Версия        : 1.0.3.435244168
' Дата          : 28.02.2019 10:00:12
' Автор         : iKaRus_VLZ (KashRus@gmail.com)
' Примечания    : работает с .RowSourceType="Table/Query" и "Value List" (с оговорками, см. p_FilterList)
' v.1.0.3       : добавлена возможность фильтровать списки "Value List"
' v.1.0.2       : добавлена SelectItem для принудительного выбора значения списка по коду
'=========================
' Пример использования:
'=========================
'' объявляем класс с событиями
'Dim WithEvents lst As clsAutoFilteredCombo
'' инициализируем селектор записей
'Private Sub Form_Open(Cancel As Integer)
'' lstMyList - имя контрола комбобокса на форме
'    Set lst = New clsAutoFilteredCombo: lst.Init lstMyList
'End Sub
'' обработка выбора в списке
'Private Sub lst_ItemSelected(Key As Variant)
'' Key - ключ списка (значение связанного столбца списка)
'' здесь можно сделать переход по записи или иное действие с ключом
'End Sub
'=========================
Public Event ItemSelected(Key As Variant) ' событие при выборе значения в ComboBox
Private WithEvents mCombo As Access.ComboBox
Private strListSource As String ' источник данных ComboBox
Private strListFilter As String ' имя поля источника отображаемого в ComboBox
Private bytColVis As Byte       ' номер первой видимой колонки в ComboBox
Private aPos() As Integer       ' позиции элементов в строке strListSource для "Value List"
Private bolJustEnter As Boolean
Private Const c_strListDelim = ";"
Private Const c_strCustomProc = "[Event Procedure]"
Public Sub Init(Combo As Access.ComboBox)
    Set mCombo = Combo
    Call p_GetListParams
    With mCombo
        .OnChange = c_strCustomProc
        .OnEnter = c_strCustomProc
        .OnKeyPress = c_strCustomProc
        .OnMouseUp = c_strCustomProc
        .AfterUpdate = c_strCustomProc
        .OnNotInList = c_strCustomProc
'        Select Case .RowSourceType
'        Case "Table/Query":
'        Case "Value List":
'        Case "Field List":  ' не предусмотрено
'        End Select
    End With
End Sub
Private Sub Class_Terminate()
    Set mCombo = Nothing: Erase aPos
End Sub
Public Sub SelectItem(Key)
' выбор в списке элемента по ключу
    With mCombo
        .RowSource = p_GetSource(vbNullString) ' сброс фильтра
        .Value = Key
    End With
End Sub
Private Sub mCombo_Change()
' получаем строку фильтра и вызываем фильтрацию списка
Dim strFilter As String
    With mCombo
        strFilter = Left$(Nz(.Text, vbNullString), .SelStart)
        If Len(strFilter) > 0 Then
            .RowSource = p_GetSource(strFilter): .Dropdown
        ElseIf Len(.Text) = 0 Then
            .RowSource = p_GetSource(vbNullString)
        End If
    End With
End Sub
Private Sub mCombo_AfterUpdate()
' меняем значение контрола на выбранное в списке
    With mCombo
' если есть разница между автовыбором в поле и выделением в списке
' выбирается то что выделено в списке
        If .ListIndex < 0 Then Exit Sub
        Dim varValue As Variant: varValue = .ItemData(IIf(.Text <> .Column(1, 0), .ListIndex, 0))
        .Value = varValue: RaiseEvent ItemSelected(varValue) ' здесь переход к записи с ID=.Value
    End With
End Sub
Private Sub mCombo_KeyPress(KeyAscii As Integer)
' при нажатии ВВОД переход на следующее поле
    If KeyAscii = 13 Then SendKeys "{TAB}"
End Sub
Private Sub mCombo_Enter(): bolJustEnter = True: End Sub
Private Sub mCombo_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
' если осуществлен вход в поле щелчком мыши - курсор в начало и выделяем содержимое
    With mCombo
        If bolJustEnter And .SelStart > 0 And Not IsNull(.Value) Then
            .SelStart = 0:      .SelLength = Len(.Text)
            .RowSource = p_GetSource(vbNullString)
        End If
    End With
    bolJustEnter = False
End Sub
Private Sub mCombo_NotInList(NewData As String, Response As Integer)
    Response = acDataErrContinue
    mCombo.Undo
End Sub
Private Sub p_GetListParams()
Dim aCol() As String, i As Long, iMax As Long
Dim rst As DAO.Recordset
    With mCombo
' получаем номер отображаемой колонки
        aCol = Split(.ColumnWidths, c_strListDelim): i = LBound(aCol): iMax = UBound(aCol)
        Do While i <= iMax
            If Len(aCol(i)) = 0 Then Exit Do
            If CLng(aCol(i)) > 0 Then Exit Do
            i = i + 1
        Loop
        bytColVis = i
        If .ColumnCount <= i Then .ColumnCount = i + 1
' получаем источник данных списка и необходимые вспомогательные данные
        strListSource = Trim$(.RowSource)
        Select Case .RowSourceType
        Case "Table/Query"
    ' для запроса получаем имя первого отображаемого в списке поля
            If Right$(strListSource, 1) = ";" Then strListSource = Left$(strListSource, Len(strListSource) - 1)
            Set rst = CurrentDb.OpenRecordset(strListSource, dbOpenForwardOnly)
            strListFilter = rst.Fields(bytColVis).name
            rst.Close: Set rst = Nothing
        Case "Value List"
    ' для списка формируем массив с позициями разделителей элементов списка
            Dim n As Long: n = 0
            i = 1: iMax = Len(strListSource)
            Do While i <= iMax
                i = InStr(i, strListSource, c_strListDelim)
                If i = 0 Then Exit Do Else i = i + 1
                ReDim Preserve aPos(n): aPos(n) = i: n = n + 1
            Loop
        Case "Field List"
    ' не предусмотрено
        End Select
    End With
End Sub
Private Function p_GetSource(strFilter As String) As String
' получаем значение для RowSourse с учетом заданного фильтра
Const c_strProcedure = "p_GetSource"
Dim Result As String

    Result = strListSource
    On Error GoTo HandleError
    strFilter = Trim(strFilter)
    If Len(strFilter) = 0 Then GoTo HandleExit
    Select Case mCombo.RowSourceType
    Case "Table/Query": Result = p_FilterQuery(strFilter)
    Case "Value List":  Result = p_FilterList(strFilter)
    Case "Field List":  Result = strListSource ' не предусмотрено
    End Select
HandleExit:
    p_GetSource = Result
    Exit Function
HandleError:
    Result = strListSource
    Err.Clear
    Resume HandleExit
End Function
Private Function p_FilterQuery(FilterString As String) As String
' создает запрос с заданным фильтром и возвращает результат
Const c_strProcedure = "p_FilterQuery"
' отбор значений при помощи LIKE
' строки содержащие символы: *, ?, # и т.п. могут отработать некорректно
    p_FilterQuery = sqlSelectAll & "(" & strListSource & ")" & sqlWhere & strListFilter & sqlLike & """*" & FilterString & "*"""
End Function
Private Function p_FilterList(FilterString As String) As String
' создает список с разделителями отфильтрованный заданный строкой и возвращает результат
Const c_strProcedure = "p_FilterList"
' !!! необходимо оптимизировать !!!

' отбор по списку при помощи InStr
' не учитывает наличие кавычек у текстовых значений, также не проверяет символ разделителя списка
' строки поиска содержащие кавычки или разделитель могут отработать некорректно
' при необходимости несложно доработать
Dim Result As String
    On Error GoTo HandleError
    Result = strListSource
    If Len(FilterString) = 0 Then GoTo HandleExit
Dim i As Long, iMax As Long ', iMin As Long
Dim s As Long, sMax As Long, sBeg As Long, sEnd As Long
Dim r As Long, cMax As Long
    Result = vbNullString
    cMax = mCombo.ColumnCount
    s = 1: sMax = Len(strListSource)
    i = LBound(aPos): iMax = UBound(aPos) ': iMin = iMin
    Do While s <= sMax
        s = InStr(s, strListSource, FilterString): If s = 0 Then Exit Do
    ' совпадение найдено - проверяем в какой колонке
        Do While i <= iMax
            If s < aPos(i) Then Exit Do
            i = i + 1
        Loop
        ' индекс следующего анализируемого символа - первый символ колонки следующей после той в которой найдено совпадение
        If i <= iMax Then s = aPos(i) Else s = sMax + 1
    ' если это видимая колонка добавляем всю строку в результат
        If i Mod cMax = bytColVis Then ' If (i - iMin) Mod cMax = bytColVis Then ' если iMin<>0
            ' получаем первый и последний символ строки r
            ' в aPos отсутствует нижняя (1) и верхняя  (sMax) границы строки
            r = i \ cMax     ' номер строки списка в которой найдено совпадение
'            r = (i - iMin) \ cMax    ' если iMin<>0
            If r = 0 Then sBeg = 1 Else sBeg = aPos(r * cMax - 1)
            If ((r + 1) * cMax - 1) > iMax Then sEnd = sMax Else sEnd = aPos((r + 1) * cMax - 1) - Len(c_strListDelim) - 1
            Result = Result & c_strListDelim & Mid$(strListSource, sBeg, sEnd - sBeg + 1)
        End If
    Loop
    If Left(Result, Len(c_strListDelim)) = c_strListDelim Then Result = Mid$(Result, Len(c_strListDelim) + 1)
HandleExit:
    p_FilterList = Result
    Exit Function
HandleError:
    Result = strListSource
    Err.Clear: Resume HandleExit
End Function
15 мар 19, 12:38    [21833603]     Ответить | Цитировать Сообщить модератору
 Re: Автофильтрующийся комбобокс  [new]
iKaRus
Member

Откуда:
Сообщений: 34
Пример использования во вложении.
Не заметил - в классе в качестве SQL инструкций используются имена констант из глобального модуля. В принципе несложно заменить. В образце приложил модуль с соотв константами.

К сообщению приложен файл (AutofilteredCombobox.zip - 140Kb) cкачать
15 мар 19, 13:09    [21833679]     Ответить | Цитировать Сообщить модератору
 Re: Автофильтрующийся комбобокс  [new]
NBjHCBrc6KlSObm
Member

Откуда:
Сообщений: 72
iKaRus, вы бы хоть написали, чем ваше решение на 100 строчек лучше, чем на 10 строчек в похожей теме.
15 мар 19, 14:03    [21833810]     Ответить | Цитировать Сообщить модератору
 Re: Автофильтрующийся комбобокс  [new]
sdku
Member

Откуда: Краснодар
Сообщений: 6263
iKaRus,
я так понял что Вы хотите осуществлять поиск
Может так?(значительно проще)

К сообщению приложен файл (tmp.rar - 36Kb) cкачать
15 мар 19, 14:05    [21833820]     Ответить | Цитировать Сообщить модератору
 Re: Автофильтрующийся комбобокс  [new]
iKaRus
Member

Откуда:
Сообщений: 34
Не ставил себе задачу сравнивать. Сделал - решил что удобно (сейчас втыкаю везде где использую подходящие списки) - решил поделиться.
Потом увидел другое решение на эту тему - дал ссылку.
Но на вскидку - потенциально - большей универсальностью.
- не проверял смежное, но это должно лучше вести себя при входе выходе из поля
- возможностью работы со списками заданными строкой с разделителями
- инициализация для последующего полноценного использования с любым комбобоксом - одной строчкой.
но да - более громоздко, возможно больше памяти (для списка например создается дополнительный массив, хотя с другой стороны я не храню в классе запрос, а работаю с его текстом), ну, - пожалуй - медленнее. Есть кривизна с выходом по табу когда выбор еще не завершен.

Обновил пример:
+ добавил в пример комбу с простым списком с разделителями.
- поправил ошибку во вспомогательном модуле не имеющем отношения к основному классу (при бэкапе исходников, при отсутствии папки SRC вылетала ошибка).

К сообщению приложен файл (AutofilteredCombobox2.zip - 141Kb) cкачать
15 мар 19, 14:49    [21833921]     Ответить | Цитировать Сообщить модератору
 Re: Автофильтрующийся комбобокс  [new]
iKaRus
Member

Откуда:
Сообщений: 34
sdku,
Посмотрел - проще, - но не всегда удобнее.
У меня в оригинальной задаче может быть много очень похожих вариантов выбора, а вспомогательных данных которые надо выводить после выбора много поэтому селектор нужен во-первых компактный, а во-вторых чтобы список вариантов можно было охватить глазом - когда список сокращается пользователю понятней какой именно ему нужен.
Ну и у меня поиск по подстроке Например длинные ничего не говорящие вещи в начале текста типа "Оббщество с ограниченной ответственностью.." не мешают быстро находить нужное по значимой части текста.
15 мар 19, 14:56    [21833928]     Ответить | Цитировать Сообщить модератору
 Re: Автофильтрующийся комбобокс  [new]
sdku
Member

Откуда: Краснодар
Сообщений: 6263
iKaRus,
можете сделать форму, по которой ищите, ленточной (в ней поместится столько же записей сколько и в списке, без прокрутки)
15 мар 19, 17:57    [21834169]     Ответить | Цитировать Сообщить модератору
 Re: Автофильтрующийся комбобокс  [new]
iKaRus
Member

Откуда:
Сообщений: 34
sdku, вы не поняли - я не прошу совета как сделать. когда мне удобнее ленточную форму я делаю ленточную форму или табличную или поле поиска или разделенную форму или еще что-нибудь.
я предложил решение именно для фильтрующегося комбобокса и только его готов здесь обсуждать.
если оно вам удобно - пользуйтесь пожалуйста, если у вас есть идеи по развитию - буду благодарен если для ваших задач удобнее что-то другое - это просто значит что это решение вам не пригодилось.
И - спасибо за советы.
15 мар 19, 18:24    [21834197]     Ответить | Цитировать Сообщить модератору
 Re: Автофильтрующийся комбобокс  [new]
iKaRus
Member

Откуда:
Сообщений: 34
Изменения в основном модуле:
- добавил задержку перед применением фильтра, чтобы дать пользователю возможность завершить ввод.
Ранее фильтр ставился сразу после ввода очередного символа.
Сейчас перед применением фильтра производится проверка сколько прошло с момента ввода последнего символа и если время превышает пороговое - применяется фильтр списка.
Это необходимо для уменьшения тормозов на действительно больших списках.

Cпособ имитации события таймера отсюда: https://excelvba.ru/code/timer/htmlfile
Наверняка есть решение лучше, но пока и это выглядит вполне удовлетворительным.

К сообщению приложен файл (AutofilteredCombobox.7z - 136Kb) cкачать
21 май 19, 14:45    [21889786]     Ответить | Цитировать Сообщить модератору
 Re: Автофильтрующийся комбобокс  [new]
iKaRus
Member

Откуда:
Сообщений: 34
Идея с задержкой обработки ввода себя не оправдала.
Сама по себе идея правильная, но реализация оказалась крайне неудачная.
Периодически происходит отваливание объекта mCombo в классе что приводит к полной неработоспособности решения и необходимости переинициализации контрола. События таймера в классе продолжают срабатывать, но из-за потери объекта, получить данные фильтра и передать на обработку становится невозможным. Место и причину отваливания пока отловить не удалось.
Поэтому от этого решения пришлось отказаться и вернуться прямой фильтрации после ввода каждого символа.
Если у кого есть предложения по организации задержки обработки ввода был бы признателен.
Текущая версия класса во вложении.

К сообщению приложен файл (clsAutoFilteredCombo.zip - 6Kb) cкачать
5 июн 19, 11:00    [21902255]     Ответить | Цитировать Сообщить модератору
 Re: Автофильтрующийся комбобокс  [new]
alecko
Member

Откуда: Башкирия
Сообщений: 553
iKaRus, отказался от этой порнографии "поля со списком" в плане поиска. делаю 1-й список из 1-х букв (на самом деле 2 - 1-с кириллицей, 2-й с латиницей, но сути это не меняет) и 1/2 списка подчиненных - не надо искать клаву при поиске, все быстро.
5 июн 19, 11:25    [21902302]     Ответить | Цитировать Сообщить модератору
 Re: Автофильтрующийся комбобокс  [new]
iKaRus
Member

Откуда:
Сообщений: 34
Еще несколько правок - некорректно обрабатывались изменения в поле, в частности в результате изменения поля при перемещении по списку стрелками

К сообщению приложен файл (clsAutoFilteredCombo.zip - 6Kb) cкачать
6 июн 19, 14:07    [21903510]     Ответить | Цитировать Сообщить модератору
 Re: Автофильтрующийся комбобокс  [new]
sdku
Member

Откуда: Краснодар
Сообщений: 6263
iKaRus
Список фильтруется по мере ввода данных....
добавил в [таблицу].[поле0] записи:"абв","авб" и "вгд"
-открываю форму "главная"
-ввожу в Combo символ "а" (предлагается вариант "абв"),раскрываю список и вижу в нем ВСЕ значения из таблицы с выделенным значением "абв",аналогично если введу символ "в",выделенное значение "вгд"-стандартное поведение поляСоСписком
-стесняюсь спросить:что же делает Ваш код-его назначение и зачем пытаться (причем неудачно) изобретать велосипед?
(штатное поведение Combo сделано вполне нормально,а сокращение значений в списке достигается использованием зависимых Combo)
6 июн 19, 15:25    [21903655]     Ответить | Цитировать Сообщить модератору
 Re: Автофильтрующийся комбобокс  [new]
iKaRus
Member

Откуда:
Сообщений: 34
sdku, напрасно стесняетесь - если бы вы не спросили - я, вероятно, не скоро бы обратил бы внимание на эту особенность.
В реальной задаче, где я его использую элементы списка у меня начинаются с цифрового кода, а потом уже идет текстовой идентификатор. поэтому у меня он выглядит как корректно работающий и при вводе сначала (по коду) и по текстовой подстроке.
Это искусственное ограничение введенное в строке 178 модуля clsAutoFilteredCombo (v.1.2.4) для исключения срабатывания фильтрации при перемещении в открытом списке стрелками.
благодаря тому что вы обратили мое внимание на некорректное поведение фильтра я, вероятно, пересмотрю это условие (но позже, - пока ему надо работать). так что реально - Спасибо!

и в ответ на ваши вопросы:
- класс делает ровно то для чего предназначен - выполняет автофильтрацию списка при вводе. это было бы заметно если в вашем случае вы начали ввод не с "а" (сработал встроенный автовыбор комбы и условие в строке 178 не дало отфильтровать список по автоматически предложенному списком комбы содержимому поля - полной строке "абв"),
а попытались бы начать с "б" (встроенный автовыбор комбобокса по первым символам не сработал - содержимое поля не совпадает с элементом списка, условие 178 не срабатывает, - фильтрация списка происходит).
удаление данного условия устранит напрягший вас эффект, но создаст большее неудобство при срабатывании автовыбора списка. поэтому думаю строки 178-181 надо пересмотреть.
до этого были попытки SelStart SelLength брать только введенный кусок без предложенного автовыбором "хвоста", но там будет беда если вы попытаетесь корректировать введенное (SelStart будет не в конце) это условие мне показалось более удачным.

- велосипед по моему следует изобретать хотя бы для того чтобы понять как он работает и научиться создавать свои (если получится - даже лучше.)) в данном случае это попытка сделать сокращающийся список по подобию адресных строк в браузерах.
в моей задаче мне это реально уменьшает количество необходимых манипуляций для выбора необходимой записи примерно на 1,5-2 секунды на запись - при массовом вводе это много.
ПыСы - позже подумаю как корректно переписать условие. Еще раз спасибо за замечание.
6 июн 19, 21:30    [21904034]     Ответить | Цитировать Сообщить модератору
 Re: Автофильтрующийся комбобокс  [new]
iKaRus
Member

Откуда:
Сообщений: 34
Кстати, - по горячим следам, пока свежа мысль:
' .Text меняется:
        If .TEXT = mCombo.Column(mbytColVis, mCombo.ListIndex) Then
'   - при срабатывании автовыбора списка если выделена вся строка (например при перемещении стрелками по списку) - не применяем фильтр
            If .SelStart = 0 And .SelLength = Len(.TEXT) Then GoTo HandleExit
'   - при срабатывании автовыбора списка если идет ввод (выделен хвост предложенный автовыбором) - применяем фильтр, - берём левую часть ввода от выделения
            mstrFilter = VBA.Left$(.TEXT, .SelStart)
        Else
'   - при вводе/удалении символа - применяем фильтр
            mstrFilter = .TEXT: If Err Then mstrFilter = .Value: Err.Clear
        End If

такое условие должно устранить эту проблему.

К сообщению приложен файл (AutofilteredCombobox_20190606_232339.7z - 143Kb) cкачать
6 июн 19, 22:36    [21904073]     Ответить | Цитировать Сообщить модератору
 Re: Автофильтрующийся комбобокс  [new]
sdku
Member

Откуда: Краснодар
Сообщений: 6263
iKaRus,
Trim удаляет пробелы в начале и в конце СТРОКИ (RowSourse всегда был набором) и чему, по Вашему, должно равняться?
mstrSource = Trim$(.RowSource)
(это одно,далеко не единственное, "интересное" место Вашего кода)
7 июн 19, 10:49    [21904288]     Ответить | Цитировать Сообщить модератору
 Re: Автофильтрующийся комбобокс  [new]
Панург
Member

Откуда: настоящему индейцу завсегда везде ништяк
Сообщений: 4368
sdku
RowSourse всегда был набором
ой!
7 июн 19, 10:56    [21904295]     Ответить | Цитировать Сообщить модератору
 Re: Автофильтрующийся комбобокс  [new]
iKaRus
Member

Откуда:
Сообщений: 34
sdku, не уверен что понял что вы имели ввиду - RowSource м.б. текстом SQL запроса или именем таблицы/запроса при RowSourceType="Table/Query", либо списком значений с разделителями при RowSourceType="Value List", "Field List" пользоваться не приходилось - там не знаю. Я не в курсе как Acc обрабатывает передаваемую RowSource строку, - может это и не нужно, но привычка - пуще неволи, а я привык обрезать строки от мусора.
Не вижу почему это неверно - максимум избыточно.
Интересные места это хорошо)) Если что-то вызывает у вас сомнения - спрашивайте: смогу - поясню, если окажется косяк - подумаю как исправить - затем и выложил)
7 июн 19, 12:25    [21904408]     Ответить | Цитировать Сообщить модератору
 Re: Автофильтрующийся комбобокс  [new]
sdku
Member

Откуда: Краснодар
Сообщений: 6263
iKaRus
Список фильтруется по мере ввода данных....
А этот пример не делает это?
(если в Like добавить "*" звездочку будет искать в любом месте строки)


К сообщению приложен файл (tmp.rar - 13Kb) cкачать
7 июн 19, 13:56    [21904504]     Ответить | Цитировать Сообщить модератору
 Re: Автофильтрующийся комбобокс  [new]
iKaRus
Member

Откуда:
Сообщений: 34
sdku, примерно с такого оно когда-то и начиналось), только я бы добавил в маску ещё одну звёздочку - перед введённым текстом.
а дальше начинаются улучшалочки для сокращения колчества движений: при выходе из поля надо что-бы выбралось первое отфильтрованное (если нет прямого выбора в списке), при входе в поле надо выделить все введенное чтобы при новом вводе текст замещал старый а не дополнял его и т.п. потом выясняется что при перемещении по списку срабатывает Change и прочие подобные мелочи и начинаются костыли и разрастание кода..

Как выяснилось последняя версия условия тоже не всегда ведет себя адекватно - иногда ListIndex выдает значение не соответствующее автоматически выбранному в поле что вызывает неправильное поведение фильтра.
Надо искать дальше, - но по большому счёту это мелочь - здесь хоть понятно куда копать - на самом деле, в контексте задачи, меня больше интересует как получше организовать задержку применения фильтра после ввода. Способ который я пытался приспсообить к случаю (создание внешнего таймера в HTML объекте) ведет себя не стабильно. Иногда (редко, но непонятно) отваливается объектная переменная в классе, иногда - выдает ошибку скрипта (было один раз).
7 июн 19, 17:30    [21904775]     Ответить | Цитировать Сообщить модератору
 Re: Автофильтрующийся комбобокс  [new]
iKaRus
Member

Откуда:
Сообщений: 34
Update.
ввиду продолжающегося на ходу отлова и исправления багов выглядит несколько сумбурно (уже требует зачистки от лишнего кода и устаревших комментариев), но вполне работоспособно.
Тестировался преимущественно на списках с RowSourceType="Table/Query" заданных через RecordSource.
текущий текст модуля под спойлером
+ clsAutoFilteredCombo

Option Compare Database
Option Explicit
'=========================
Private Const c_strModule As String = "clsAutoFilteredCombo"
'=========================
' Описание      : Класс для работы с автофильтрующимися комбобоксами.
' Версия        : 1.2.6.436355522
' Дата          : 19.06.2019 13:15:10
' Автор         : Кашкин Р.В. (KashRus@gmail.com)
' Примечания    : работает с .RowSourceType="Table/Query" и "Value List" (с оговорками, см. p_FilterValueList) _
                  если GROUPPROC=True в проекте д.б. clsRelay _
                  опорный запрос должен быть оптимизирован т.к. использование автофильтра заметно замедляет его работу _
                  в тексте запроса источника строк списка следует избегать групповых функций, _
                  в частности Dlookup можно заменить на Choose, это критически влияет на производительность
' v.1.2.6       : 14.06.2019 - исправлены старые, известные ошибки,- сделаны новые, пока неизвестные..)
' v.1.2.0       : 28.05.2019 - добавлена возможность работы с рекордсетом вместо RowSource (попытка ускорить исполнение запросов)
' v.1.1.2       : 22.05.2019 - добавлена возможность групповой обработки Combobox'ов
' v.1.1.1       : 21.05.2019 - добавлена возможность ожидания завершения ввода (см.TimerProc) для ускорения работы в длинных списках
' v.1.0.3       : 28.02.2019 - добавлена возможность фильтровать списки "Value List"
' v.1.0.1       : 19.06.2018 - исходная версия
'=========================
#Const GROUPPROC = False   ' True  - используется группповая обработка списков (нужен clsRelay),
                            ' False - группповая обработка не используется
#Const USERECORDSET = False ' True  - использовать Recordset для фильтрации списка,
                            ' False - использовать RowSource для фильтрации списка.
    ' !!! где-то ошибка - при True после использования класса при закрытии Access вылетает
#Const USEDELAY = False     ' True  - примененять фильтр после завершения ввода (по событию TimerProc) есть неотлаженные косяки с потерей mCombo,
                            ' False - примененять фильтр после каждого изменения (по событию Change)
    ' хорошая идея - плохая реализация  - иногда теряет объект mCombo, что приводит к неработоспособностии кода.  место и причину пока не отловил.
    ' надо поискать другой способ организации события таймера в пользовательском классе.
'=========================
' Пример использования:
'-------------------------
' Пример использования класса для одиночных списков
'-------------------------
'Dim WithEvents lst As clsAutoFilteredCombo ' объявляем класс с событиями
'' инициализируем селектор записей
'Private Sub Form_Open(Cancel As Integer)
'' lstMyList - имя контрола комбобокса на форме
'    Set lst = New clsAutoFilteredCombo: lst.Init lstMyList
'End Sub
'Private Sub Form_Close(): Set lst = Nothing: End Sub
'' обработка выбора в списке
'Private Sub lst_ItemSelected(Key As Variant)
'' Key - ключ списка (значение связанного столбца списка)
'' здесь можно сделать переход по записи или иное действие с ключом
'End Sub
'-------------------------
' Пример использования класса для групповой обработки списков:
'-------------------------
'Private WithEvents mRelay As clsRelay   ' для ретрансляции событий группы контролов в форму
'Private colCtls As Collection           ' коллекция для хранения элементов clsAutoFilteredCombo
'
'Private Sub Form_Open(Cancel As Integer)
'   Set colCtls = New Collection: Set mRelay = New clsRelay
'End Sub
'Private Sub Form_Close()
'   Set colCtls = Nothing: Set mRelay = Nothing
'End Sub
'Private Sub mRelay_GetParent(PARENT As Object): Set PARENT = Me:End Sub
'Private Sub p_InitControl(ctl As Access.Control)
''p_InitControl необходимо вызвать для каждого списка который должен получить групповой обработчик событий
' Dim cTransf As New clsAutoFilteredCombo
'   cTransf.Init EventControl:=ctl, Relay:=mRelay, Index:=colCtls.Count: colCtls.Add cTransf
'End Sub
'Public Sub EventControl_ItemSelected(EventControl As Access.Control, Optional Key as Variant) 'As Integer
'' собственно пример группового обработчика событий
'' EventControl - содержит ссылку на контрол вызвавший событие
'End Sub
'=========================
Public Event ItemSelected(Key As Variant) ' событие при выборе значения в ComboBox
Private WithEvents mCombo As Access.ComboBox
Attribute mCombo.VB_VarHelpID = -1

Private mstrSource As String    ' источник данных ComboBox
Private mstrFieldName As String ' имя поля источника отображаемого в ComboBox

#If USERECORDSET Then       ' если для фильтрации используется Recordset
Private mrstSource As Recordset ' исходный рекордсет ComboBox
#End If

#If USEDELAY Then           ' если используется ожидание завершения ввода
Private Const c_intWait = 500   ' время ожидания нажатия клавиши до применения фильтра (в ms)
Private Const c_intPeriod = 50  ' период срабатывания таймера (в ms)

Private mobjDoc As Object       ' объект HTML в котором создается при помощи JS таймер
Private Const c_strAttribute = "VBATimerHandler" ' имя аттрибута для хранения значения таймера в объекте HTML
Private mvarTimerId As Variant  ' параметр для последующего выполнения ClearInterval
Private mlngEnterPrev As Long   ' время предыдущего ввода
Private mbolChange As Boolean   ' флаг изменения фильтра
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
#End If 'USEDELAY

#If GROUPPROC Then
Private mRelay As clsRelay
Private mIndex As Long
#End If 'GROUPPROC

Private mstrFilter As String    ' значение поля фильтра
Private mbytColVis As Byte      ' номер первой видимой колонки в ComboBox
Private marrPos() As Integer    ' позиции элементов в строке mstrSource для "Value List"
Private mbolAutoSel As Boolean  ' признак того что сработал стандартный автовыбор Combobox
Private mbolJustEnt As Boolean  ' признак что вход в поле только что осуществлен, ввода еще не было
Private Const c_strListDelim = ";"
Private Const c_strCustomProc = "[Event Procedure]"

#If GROUPPROC Then
Public Sub Init( _
    EventControl As Access.Control, _
    Optional Relay As clsRelay, _
    Optional Index As Long _
    )
' инициализация для групповой обработки
#Else   'GROUPPROC
Public Sub Init( _
    EventControl As Access.Control, _
    Optional Relay As Object, _
    Optional Index As Long _
    )
' инициализация контрола без групповой обработки
' здесь Relay и Index не используются сохранены для единства синтаксиса
#End If 'GROUPPROC
    Set mCombo = EventControl
    mbolJustEnt = False: mbolAutoSel = False
#If GROUPPROC Then
    mIndex = Index: Set mRelay = Relay
#End If 'GROUPPROC
' получаем параметры источника данных
    Call p_InitCombo
' настраиваем обработчики событий
    With mCombo
        .OnChange = c_strCustomProc
        .OnEnter = c_strCustomProc
        .OnMouseUp = c_strCustomProc
        .AfterUpdate = c_strCustomProc
        .OnNotInList = c_strCustomProc
        .OnKeyDown = c_strCustomProc
    End With
End Sub
Private Sub Class_Terminate()
#If GROUPPROC Then
    Set mRelay = Nothing
#End If 'GROUPPROC
#If USERECORDSET Then
    mrstSource.Close: Set mrstSource = Nothing
#End If 'USERECORDSET
#If USEDELAY Then
    p_TimerStop
#End If 'USEDELAY
    Set mCombo = Nothing: Erase marrPos
End Sub
#If GROUPPROC Then
Public Property Let Index(rData As Long): mIndex = rData: End Property
Public Property Get Index() As Long: Index = mIndex: End Property
#End If 'GROUPPROC
Public Sub SelectItem(Key)
' выбор в списке элемента по ключу
    With mCombo
    ' меняем значение и вызываем события
        p_SetFilter (vbNullString)                  ' сбрасываем фильтр перед выбором
        .Value = Key: RaiseEvent ItemSelected(Key)  ' здесь переход к записи с ID=.Value
#If GROUPPROC Then
    On Error GoTo HandleError
        Call mRelay.Parent.EventControl_ItemSelected(mCombo, Key)
#End If 'GROUPPROC
    End With
HandleExit:
    Exit Sub
HandleError:
    Err.Clear: Resume HandleExit
End Sub
' обработка событий контрола
Private Sub mCombo_Enter(): mbolJustEnt = True: End Sub ' ставим признак входа в поле
Private Sub mCombo_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If mbolJustEnt Then
' если осуществлен вход в поле щелчком мыши или табом
        With mCombo
            If IsNull(.Value) Then
            Else
' если в поле есть выбор
    ' проверяем был ли вход по щелчку на кнопке выпадающего меню
        ' опытным путем подобрал такое условие.
        ' почему так - не понятно. условие некорректно, но лучше пока не придумал
        ' если бы был выбор в поле нулевой позиции, то д.б. .SelLength = 0
                If .SelStart = 0 And .SelLength = Len(.Text) Then
        ' если да - при установке фильтра происходит срыв списка, поэтому - пропуск
                Else
        ' если нет - курсор в начало и выделяем содержимое
                    .SelStart = 0:  .SelLength = Len(.Text)
                    p_SetFilter (vbNullString): mbolJustEnt = False
                End If
            End If
        End With
    End If
HandleExit:
    Exit Sub
HandleError:
    Err.Clear: Resume HandleExit
End Sub
Private Sub mCombo_NotInList(NewData As String, Response As Integer)
    Response = acDataErrContinue: mCombo.Undo
End Sub
Private Sub mCombo_Change()
' получаем строку фильтра
    With mCombo
On Error Resume Next
' !!! Внимание !!!
' если есть совпадение сначала строки - срабатывает автовыбор комбобокса > меняется ListIndex

' .Text меняется:
        mbolJustEnt = False
        mbolAutoSel = .Text = .Column(mbytColVis, .ListIndex)
        If mbolAutoSel Then
'   - при срабатывании автовыбора списка
    ' если выделена вся строка (например при перемещении стрелками по списку) - не применяем фильтр
            If .SelStart = 0 And .SelLength = Len(.Text) Then GoTo HandleExit
    ' если выделен хвост предложенный автовыбором (идет ввод) - применяем фильтр, - берём левую часть ввода от выделения
            mstrFilter = VBA.Left$(.Text, .SelStart)
        Else
'   - при вводе/удалении символа - применяем фильтр
            mstrFilter = .Text ': If Err Then mstrFilter = .Value: Err.Clear
'If Len(mstrFilter) = 0 Then Stop
        End If
' если применять фильтр после каждого изменения длинные списки будут очень тормозить
' нужно дать пользователю возможность завершить ввод
        mstrFilter = VBA.Trim$(mstrFilter)
#If USEDELAY Then
' если используется задержка ввода - фиксируем время, устанавливаем флаг изменения и ждем события таймера
        mlngEnterPrev = GetTickCount     ' запоминаем таймер текущего ввода
        mbolChange = True          ' устанавливаем флаг фильтр изменился
#Else  'USEDELAY
' если не используется задержка - применяем фильтр сразу
        If Len(mstrFilter) > 0 Then
            p_SetFilter (mstrFilter): .Dropdown
        Else
            p_SetFilter (vbNullString)
        End If
#End If 'USEDELAY
    End With
HandleExit:
    Exit Sub
HandleError:
    Err.Clear: Resume HandleExit
End Sub
Private Sub mCombo_KeyDown(KeyCode As Integer, Shift As Integer)
' при нажатии ТАБ/ВВОД
    ' при закрытом списке происходит выбор
    ' при открытом списке происходит срыв выьбора
    Select Case KeyCode
    Case vbKeyTab:      If Shift = 0 Then SelectItem p_GetSelectedKey
    Case vbKeyReturn:   SelectItem p_GetSelectedKey
    End Select
HandleExit:
    Exit Sub
HandleError:
    Err.Clear: Resume HandleExit
End Sub
Private Sub mCombo_AfterUpdate(): SelectItem p_GetSelectedKey: End Sub
Private Function p_GetSelectedKey() 'As Long
Dim Result 'As Long
On Error GoTo HandleError
Dim i As Long: i = 0 ' индекс возвращаемого элемента
    With mCombo
' ListIndex не всегда выдает ожидаемое значение -
    ' при установке RowSource список меняется, а ListIndex остается прежний.
    ' и может не соответствовать автовыбору в поле или вовсе оказаться за пределами списка
        If .Column(mbytColVis, .ListIndex) = .Text Then
            i = .ListIndex
        Else
' есть очевидное плохое решение - поиск перебором в списке
    ' или его аналоги - поиск в источнике и возврат резульатата не из Combo, а из источника данных Combo
            i = .ListCount - 1
            Do While i > 0
                If .Column(mbytColVis, i) = .Text Then Result = .Column(.BoundColumn - 1, i): Exit Do
                i = i - 1
            Loop
        End If
        Result = .Column(.BoundColumn - 1, i)
        
' есть некорректное, но не требующее перебора а значит более быстрое на длинных списках
    ' в таком случае после фильтрации нужно мышью либо стрелками выбрать в списке нужный пункт
    ' иначе (по выходу из поля может произойти выбор неверного значения)
'        Select Case .ListIndex
'        Case 0 To .ListCount - 1: Result = .Column(.BoundColumn - 1, .ListIndex)
'        Case Else:                Result = .Column(.BoundColumn - 1, 0)
'        End Select
    End With
HandleExit:
'If Result = 0 Or IsNull(Result) Then Stop
    p_GetSelectedKey = Result
    Exit Function
HandleError:
    Err.Clear: Resume HandleExit
End Function
Private Sub p_InitCombo()
' получает все необходимые для работы класса параметры списка
Dim aCol() As String, i As Long, iMax As Long
    With mCombo
' получаем номер отображаемой колонки
        aCol = Split(.ColumnWidths, c_strListDelim): i = LBound(aCol): iMax = UBound(aCol)
        Do While i <= iMax
            If Len(aCol(i)) = 0 Then Exit Do
            If CLng(aCol(i)) > 0 Then Exit Do
            i = i + 1
        Loop
        mbytColVis = i
        If .ColumnCount <= i Then .ColumnCount = i + 1
' получаем источник данных списка и необходимые вспомогательные данные
        mstrSource = Trim$(.RowSource)

        Select Case .RowSourceType
        Case "Table/Query"
            If Right$(mstrSource, 1) = ";" Then mstrSource = Left$(mstrSource, Len(mstrSource) - 1)
#If USERECORDSET Then
            If .Recordset Is Nothing Then .Requery
            Set mrstSource = .Recordset.Clone 'исходный запрос
            mstrFieldName = mrstSource.Fields(mbytColVis).NAME
#Else  'USERECORDSET
    ' для запроса получаем имя первого отображаемого (фильтруемого) поля списка
            Dim strSQL As String: strSQL = sqlSelect1st & "(" & mstrSource & ")"
            Dim rst As Recordset: Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenForwardOnly)
            mstrFieldName = rst.Fields(mbytColVis).NAME
            rst.Close: Set rst = Nothing
#End If 'USERECORDSET
        Case "Value List"
    ' для списка формируем массив с позициями разделителей элементов списка
            Dim n As Long: n = 0
            i = 1: iMax = Len(mstrSource)
            Do While i <= iMax
                i = InStr(i, mstrSource, c_strListDelim)
                If i = 0 Then Exit Do Else i = i + 1
                ReDim Preserve marrPos(n): marrPos(n) = i: n = n + 1
            Loop
        Case "Field List"
    ' не предусмотрено
        End Select
    End With
#If USEDELAY Then
' запускаем таймер
    mbolChange = False
    mlngEnterPrev = GetTickCount(): p_TimerStart
#End If 'USEDELAY
End Sub
Private Function p_SetFilter(FilterText As String) As Boolean
' устанавливает текстовой фильтр на источник
Const c_strProcedure = "p_SetFilter"
' !!! при замене RowSource ListIndex остается прежним !!!
Dim Result As Boolean

    Result = True
    On Error GoTo HandleError
    DoCmd.Echo False
    FilterText = VBA.Trim$(FilterText)
    With mCombo
    ' выбираем способ фильтрации
        Select Case .RowSourceType
        Case "Table/Query":
    ' источник - запрос
#If USERECORDSET Then
        ' для фильтрации используется Recordset
            If Len(FilterText) = 0 Then Set .Recordset = mrstSource: GoTo HandleExit
            Dim strFilter As String:  strFilter = mstrFieldName & sqlLike & """*" & VBA.Replace(FilterText, " ", "*") & "*"""
            Dim rst As Recordset: Set rst = mrstSource.Clone: rst.Filter = strFilter
            Set .Recordset = rst.OpenRecordset: rst.Close: Set rst = Nothing
#Else  'USERECORDSET
        ' для фильтрации используется RowSource
        ' отбор значений при помощи LIKE. Cтроки содержащие символы: *, ?, # и т.п. могут отработать некорректно
            If Len(FilterText) = 0 Then .RowSource = mstrSource: GoTo HandleExit
            Dim strFilter As String:  strFilter = mstrFieldName & sqlLike & """*" & VBA.Replace(FilterText, " ", "*") & "*"""
            .RowSource = sqlSelectAll & "(" & mstrSource & ")" & sqlWhere & strFilter
#End If 'USERECORDSET
        Case "Value List"
    ' источник - список с разделителями
            If Len(FilterText) = 0 Then .RowSource = mstrSource: GoTo HandleExit
            .RowSource = p_FilterValueList(FilterText)
        'Case "Field List": ' не предусмотрено
        End Select
    ' восстанавливаем предложенное автовыбором значение в списке и выделение
        ' ListIndex вопреки хелпу можно менять, но получишь ошибку #7777
    End With
HandleExit:
    DoCmd.Echo True
    p_SetFilter = Result
    Exit Function
HandleError:
    
    Select Case Err.Number
    Case 7777: Err.Clear: Resume Next       ' ошибка ListIndex - продолжить исполнение
    Case Else: Result = False: Err.Clear: Resume HandleExit
    End Select
    Err.Clear: Resume HandleExit
End Function
Private Function p_FilterValueList(FilterString As String) As String ', Optional lIdx As Long) As String
' создает список с разделителями отфильтрованный заданный строкой и возвращает результат
Const c_strProcedure = "p_FilterValueList"
' !!! необходимо оптимизировать !!!

' отбор по списку при помощи InStr
' не учитывает наличие кавычек у текстовых значений, также не проверяет символ разделителя списка
' строки поиска содержащие кавычки или разделитель могут отработать некорректно
' при необходимости несложно доработать
Dim Result As String
    On Error GoTo HandleError
    Result = mstrSource
    If Len(FilterString) = 0 Then GoTo HandleExit
Dim i As Long, iMax As Long ', iMin As Long             ' индексы массива
Dim c As Long, cMax As Long, cBeg As Long, cEnd As Long ' индексы строки (номер символа)
Dim Row As Long, colMax As Long                         ' индексы списка
    Result = vbNullString
    colMax = mCombo.ColumnCount
    c = 1: cMax = Len(mstrSource)
    i = LBound(marrPos): iMax = UBound(marrPos) ': iMin = iMin
    Do While c <= cMax
        c = InStr(c, mstrSource, FilterString): If c = 0 Then Exit Do
    ' совпадение найдено - проверяем в какой колонке
        Do While i <= iMax
            If c < marrPos(i) Then Exit Do
            i = i + 1
        Loop
        ' индекс следующего анализируемого символа - первый символ колонки следующей после той в которой найдено совпадение
        If i <= iMax Then c = marrPos(i) Else c = cMax + 1
    ' если это видимая колонка добавляем всю строку в результат
        If i Mod colMax = mbytColVis Then ' If (i - iMin) Mod colMax = mbytColVis Then ' если iMin<>0
            ' получаем первый и последний символ строки row
            ' в marrPos отсутствует нижняя (1) и верхняя  (cMax) границы строки
            Row = i \ colMax     ' номер строки списка в которой найдено совпадение
'            row = (i - iMin) \ colMax    ' если iMin<>0
            If Row = 0 Then cBeg = 1 Else cBeg = marrPos(Row * colMax - 1)
            If ((Row + 1) * colMax - 1) > iMax Then cEnd = cMax Else cEnd = marrPos((Row + 1) * colMax - 1) - Len(c_strListDelim) - 1
            Result = Result & c_strListDelim & Mid$(mstrSource, cBeg, cEnd - cBeg + 1)
        End If
    Loop
    If Left(Result, Len(c_strListDelim)) = c_strListDelim Then Result = Mid$(Result, Len(c_strListDelim) + 1)
HandleExit:
    p_FilterValueList = Result
    Exit Function
HandleError:
    Result = mstrSource
    Err.Clear: Resume HandleExit
End Function

#If USEDELAY Then
Public Sub TimerProc()
' имитирует событие Таймера. срабатывает каждые c_intPeriod милисекунд
    If Not mbolChange Then Exit Sub
    If (GetTickCount() - mlngEnterPrev) < c_intWait Then Exit Sub
' если со времени последнего ввода прошло больше c_intWait милисекунд
' и фильтр изменился - устанавливаем фильтр
    With mCombo
        If Len(mstrFilter) > 0 Then
            p_SetFilter (mstrFilter): .Dropdown
        ElseIf Len(.Text) = 0 Then
            p_SetFilter (vbNullString)
        End If
    End With
    mbolChange = False ' сброс флага необходимости установки фильтра
End Sub
Private Sub p_TimerStart()
' запускает локальный таймер с интервалом срабатывания c_intPeriod
' каждые c_intPeriod милисекунд будет вызываться проседура TimerProc
Const cstrScript = "document.documentElement.getAttribute('" & c_strAttribute & "').TimerProc()"
    p_TimerStop
    Set mobjDoc = CreateObject("htmlfile")
    mobjDoc.DocumentElement.setAttribute c_strAttribute, Me
    mvarTimerId = mobjDoc.parentWindow.setInterval(cstrScript, c_intPeriod)
End Sub
Private Sub p_TimerStop()
' останавливает таймер
    If mobjDoc Is Nothing Then Exit Sub
    If Not IsEmpty(mvarTimerId) Then
        mobjDoc.parentWindow.clearInterval mvarTimerId
        mvarTimerId = Empty
    End If
    mobjDoc.DocumentElement.removeAttribute c_strAttribute
    Set mobjDoc = Nothing
End Sub
#End If 'USEDELAY


Попытался исправить известные мне ошибки связанные со срывом выбора в списке.

Выяснилось следующее: ListIndex, который я использовал для идентификации выбранного в списке значения, после применения фильтра (замены источника списка) остается прежним, в то время как остальные параметры списка в т.ч. ListCount меняются.
т.о. получается что в поле, как бы выбрано нужное значение (.Text после применения сохранилось), список сократился, искомый элемент в списке по фильтру отобран, но - индекс выбора (ListIndex) указывает на позицию, которую этот элемент занимал в списке ДО применения фильтра, т.е. он может соответствовать/не соответствовать или вообще выходить за границы списка. Отсюда естественно возникала ошибка.
Не знаю чего я от него ожидал - вероятно просто ситуация, что раз в text выбор сохранился, то и в списке тоже должен мне показалась само собой разумеющейся, хотя если подумать - логичным поведением Combobox в подобной ситуации д.б. сброс индекса (например в 0 или -1) поскольку фактически изменен источник данных. тем не менее исходим из того что есть.

Поскольку проблема в неправильном индексе несоответствующем текущему выбору сходу видны три возможных варианта устранения проблемы:
1. в лоб - просмотреть список и найти значение соответствующее правильному выбору и вернуть его (плюсы - простота, минусы - полный перебор списка)
2. вариант предыдущего. тоже, но поиск осуществлять не в списке, а в источнике списка (плюсы - относительная простота, минусы - придется создавать объект - запрос соотв тексту источника и производить поиск в нем - показалось лишним так как запрос уже был однажды вызван - когда мы подменили источник и если он содержит сложные формулы то работа с ним может оказаться заметно медленнее чем работа с уже годовым списком полученным из этого запроса). отказался т.к. нет очевидных преимуществ.
3. доверить выбор нужного значения встроенному автовыбору Combы сымитировав ввод значения (плюсы - поиск перекладывается на встроенные алгоритмы Combы, а значит он будет наверняка быстрее тупого перебора, минусы - здесь чтобы не нарваться на каскад событий Change придется заметно усложнять код (возможно ввести флаг для пропуска основного обработчика при искусственном вызове события). после пары экспериментов отказался из-за плохо контролируемого риска сваливания в мертвый цикл.
т.о. был реализован первый вариант пока он себя неплохо показывает в том числе в варианте с задержкой применения фильтра (#USEDELAY=True)

В процессе обнаружил интересный факт - вопреки Help свойство ListIndex у Access.Combobox Read/Write а не ReadOnly. При попытке записи значения в ListIndex выбор в списке меняется, но возникает ошибка 7777, т.е. если ее обработать можно использовать ListInex для управления выбором в списке. Тут можно поэкспериментировать.
19 июн 19, 22:36    [21911906]     Ответить | Цитировать Сообщить модератору
Все форумы / Microsoft Access Ответить