Все технические форумы на одном сайте Удобный поиск информации с популярных форумов в одном месте
Вопрос: в combobox фильтруется список как то непонятно

коллеги,
в combobox access 2007 фильтруется список как то непонятно ... простейший комбо - по таблице клиентов ... открываю список и начинаю ввод - по первым буквам список фильтруется ... но!!! некоторые - ок, некоторые - нифига ... проверил по буквам - всё хорошо, дошел до кодов букв ,ну, если вдруг латинские перемешались - нет, все русские ... МУП "Надежда" - находит, а вот ОАО "Мегафон" - нет ... доходит до ОАО "Ростелеком", а при введении буквы "м" - всё, не видит ...
подскажите, куда искать причину ..?
Ответ: Если нужен контекстный поиск с ограничением списка по мере поиска, ниже код класса для комбо бокса. Есть 3 режима автоматического выбора из списка, задержка поиска при скоростном наборе и минимальное число символов для начала поиска для повышения производительности. Набирать можно через пробел разные части слова/слов. Пристегивается одной строкаой кода на контрол, запрос для данных комбобокса требует небольшой модификации. Функцию обработчика ошибок только замените на свою или просто на MsgBox

+
Option Compare Database
Option Explicit

Const constTIMEOUT = 300     ' search timeout in milliseconds [300]
Const constAUTOSELECT = 1    ' 0: none; 1: pre-select; 2:full auto
Const constMINLENGHT = 2     ' minimum length of text in control for starting search


'Class for support search-as-you-type feture for comboboxes
' Author of idea: Markus G Fischer, Geneva, 2011-06
' Written for Experts-Exchange: http://e-e.com/A_6490.html
' Modified by Sergey Shingarev, Thailand, 2015-07
'
'Using: Start typing in combo, after MinLenght characters and if you stop more than TimeOut
' milliseconds, search started. Spaces in typed text replaced by "*" wildcard
' Tab-out behaviour depends on AutoSelect
'
'Using in form:
'
'In combobox:
'set Autoxpand=No
'
'in RowSource replace column for search by expression adding chr(9)
'at the begining for full disabling of system autosearch:
'ArticleProduct: Chr(9) & [Products].[ArticleProduct]
'
'and add
'Like '*' as criteria for search column. Make sure that quotes are single.
'
'Declare on module level of form
'Dim mcboProd As New clsComboSearch
'
'
'Private Sub Form_Load()
'    mcboProd.Init Me.cboId_Product
'End Sub
'
Public OnTheFly     As Boolean      ' True to search while typing [True]
Public TIMEOUT      As Integer      ' search timeout in milliseconds [300]
Public AutoSelect   As Byte         ' 0: none; 1: pre-select; 2:full auto
Public MinLenght    As Integer      ' minimum lenghth of text in control for strting search

' class-level variables, used in more than one method
Dim mvarCriteria    As Variant      ' global WHERE clause
Dim mfDirty         As Boolean      ' True if the row source was changed
Dim mvarLast        As Variant      ' currently active keyword criteria
Dim mstrSelect      As String       ' original select from combo
Dim mstrOrderBy     As String

' event variables for the combo and for a timer form
Dim WithEvents mcboAny As ComboBox
Dim WithEvents mfrmClock As Form 'separate form for timer used because timer of current form may be already used.

Public Sub Init(Combo As ComboBox, Optional Criteria = "")
      ' Captures the combo's events and the optional WHERE clause;
      ' writes the initial row source of the combo.
          
          'catch necessary events
10       On Error GoTo ErrorHandler

20        Combo.OnChange = "[Event Procedure]"
30        Combo.OnEnter = "[Event Procedure]"
40        Combo.OnExit = "[Event Procedure]"
50        Combo.OnNotInList = "[Event Procedure]"
          
60        Set mcboAny = Combo
70        mvarCriteria = Criteria
80        mstrSelect = mcboAny.RowSource
90        mfDirty = True
          'ResetRowSource

ExitHere:
100      On Error GoTo 0
110      Exit Sub

ErrorHandler:
120   Select Case Err
      Case 0
130      Resume Next
140   Case Else
150      LogError Err.Number, Err.Description, Erl, "Init", "clsComboSearch"
160      Resume ExitHere
170   End Select



End Sub

Private Sub ResetRowSource(Optional Criteria)
10       On Error GoTo ErrorHandler

20        If IsMissing(Criteria) Then Criteria = mvarCriteria
30        If Nz(Criteria, "") <> "" Then
40            mcboAny.RowSource = Replace(mstrSelect, "Like '*'", "Like '*" & Criteria & "*'")
50        Else
60            mcboAny.RowSource = mstrSelect
70            If mcboAny.ListCount < 16 Then
80                mcboAny.ListRows = IIf(Nz(mcboAny.ListCount, 0) = 0, 1, mcboAny.ListCount)
90            Else
100               mcboAny.ListRows = 16
110           End If
              'toggle dropdown for refreshing
120           SendKeys "%{DOWN}"
130           SendKeys "%{DOWN}"
140           mcboAny.Dropdown
150       End If
160       mfDirty = True

ExitHere:
170      On Error GoTo 0
180      Exit Sub

ErrorHandler:
190   Select Case Err
      Case 0
200      Resume Next
210   Case Else
220      LogError Err.Number, Err.Description, Erl, "ResetRowSource", "clsComboSearch"
230      Resume ExitHere
240   End Select

End Sub

Private Sub PerformSearch()
          Static sfBusy   As Boolean      ' semaphore
          Dim varWhere    As Variant      ' criteria
          Dim strText As String
          Dim strWords()  As String       ' array of keywords
          Dim varW        As Variant      ' keyword loop variable
          
10       On Error GoTo ErrorHandler

          ' semaphore, prevents re-entrant execution
20        Do While sfBusy: DoEvents: Loop
30        sfBusy = True
          
          ' reset time-out for on the fly searching
40        If Me.OnTheFly Then mfrmClock.TimerInterval = 0
          
          ' do not interpret an actual selection from the list
50        If mcboAny.ListCount > 0 And mcboAny.ListIndex >= 0 Then GoTo ExitHere
          
60        strText = mcboAny.Text
70        If Len(Trim(strText)) > 0 Then
      '        varWhere = ""
      '        strWords = Split(strText)
      '        For Each varW In strWords
      '            If Len(varW) Then
      '                varWhere = varWhere + " And " & "Establishment Like '*" + Swiss(varW) + "*'"
      '        Next varW
80            varWhere = Replace(strText, " ", "*")
90        Else
100           varWhere = ""
110       End If
          
          ' if next keystroke already in line, skip to end
120       If Me.OnTheFly Then If mfrmClock.TimerInterval Then GoTo ExitHere
          
130       If Nz(varWhere) <> Nz(mvarLast) Then
              ' a new criteria was built: apply it to the row source
      'Debug.Print Now(), "PerformSearch, ResetRowSource " & varWhere
140           ResetRowSource varWhere
150           If mcboAny.ListCount Then Else
160           mfDirty = True
170           DoEvents
              'toggle dropdown for refreshing
180           SendKeys "%{DOWN}"
190           SendKeys "%{DOWN}"
200           mcboAny.Dropdown
210           mvarLast = varWhere
220       End If
          
ExitHere:
          ' release semaphore
230       sfBusy = False
240      On Error GoTo 0
250      Exit Sub

ErrorHandler:
          ' release semaphore
260       sfBusy = False
270   Select Case Err
      Case 0
280      Resume Next
290   Case Else
300      LogError Err.Number, Err.Description, Erl, "PerformSearch", "clsComboSearch"
310      Resume ExitHere
320   End Select


End Sub

Private Sub Class_Initialize()
      ' set default behaviour
10       On Error GoTo ErrorHandler

20        Me.OnTheFly = True
30        Me.TIMEOUT = constTIMEOUT
40        Me.AutoSelect = constAUTOSELECT
50        Me.MinLenght = constMINLENGHT

ExitHere:
60       On Error GoTo 0
70       Exit Sub

ErrorHandler:
80    Select Case Err
      Case 0
90       Resume Next
100   Case Else
110      LogError Err.Number, Err.Description, Erl, "Class_Initialize", "clsComboSearch"
120      Resume ExitHere
130   End Select

End Sub

Private Sub Class_Terminate()
      ' release variables (superfluous precaution in this case)
10       On Error GoTo ErrorHandler

20        Set mcboAny = Nothing
30        Set mfrmClock = Nothing

ExitHere:
40       On Error GoTo 0
50       Exit Sub

ErrorHandler:
60    Select Case Err
      Case 0
70       Resume Next
80    Case Else
90       LogError Err.Number, Err.Description, Erl, "Class_Terminate", "clsComboSearch"
100      Resume ExitHere
110   End Select

End Sub

Private Sub mcboAny_Change()
      ' on change, start the timer of an instanced timer form
      'Debug.Print Now(), "mcboAny_Change"
10       On Error GoTo ErrorHandler

20        If Me.OnTheFly Then
30            If mfrmClock Is Nothing Then Set mfrmClock = New Form_frmComboBoxTimer
40            mfrmClock.TimerInterval = Me.TIMEOUT
50        End If

ExitHere:
60       On Error GoTo 0
70       Exit Sub

ErrorHandler:
80    Select Case Err
      Case 0
90       Resume Next
100   Case Else
110      LogError Err.Number, Err.Description, Erl, "mcboAny_Change", "clsComboSearch"
120      Resume ExitHere
130   End Select

End Sub

Private Sub mcboAny_Enter()
      'Debug.Print Now(), "mcboAny_Enter"
      ' access the list count property: populates the combo completely
10       On Error GoTo ErrorHandler

20        If mcboAny.ListCount Then Else

ExitHere:
30       On Error GoTo 0
40       Exit Sub

ErrorHandler:
50    Select Case Err
      Case 0
60       Resume Next
70    Case Else
80       LogError Err.Number, Err.Description, Erl, "mcboAny_Enter", "clsComboSearch"
90       Resume ExitHere
100   End Select

End Sub

Private Sub mcboAny_Exit(Cancel As Integer)
      'Debug.Print Now(), "mcboAny_Exit"
      ' release timer and resets default row source
10       On Error GoTo ErrorHandler

20        Set mfrmClock = Nothing
30        If mfDirty Then
40            ResetRowSource
50            mfDirty = False
60        End If
70        mvarLast = Null

ExitHere:
80       On Error GoTo 0
90       Exit Sub

ErrorHandler:
100   Select Case Err
      Case 0
110      Resume Next
120   Case Else
130      LogError Err.Number, Err.Description, Erl, "mcboAny_Exit", "clsComboSearch"
140      Resume ExitHere
150   End Select

End Sub

Private Sub mcboAny_NotInList(NewData As String, Response As Integer)
      'Debug.Print Now(), "mcboAny_NotInList"
          
10       On Error GoTo ErrorHandler

20        If Me.OnTheFly Then
              ' pending change?
30            If mfrmClock.TimerInterval Then PerformSearch
40        Else
50            PerformSearch
60        End If
          
70        With mcboAny
          
80            If .ListCount = 0 Then
                  ' using the combo box as message box!
90                .RowSource = "SELECT Null, '*** no matching records ***'"
100               .Undo
110               Response = acDataErrContinue
120               mfDirty = True
              
130           ElseIf (.ColumnHeads And .ListCount = 2) Or (Not .ColumnHeads And .ListCount = 1) Or Me.AutoSelect = 2 Then
                  ' automatic selection from a one-item list
140               If .ColumnHeads Then
150                   .RowSource = "SELECT " & .ItemData(1) & ", '" & NewData & "'"
160               Else
170                   .RowSource = "SELECT " & .ItemData(0) & ", '" & NewData & "'"
180               End If
190               Response = acDataErrAdded
200               mfDirty = True
                  
210           ElseIf Me.AutoSelect = 1 Then
                  ' reopen combo box, but pre-select the first item
220               .Undo
230               If .ColumnHeads Then
240                   .Value = .ItemData(1)
250               Else
260                   .Value = .ItemData(0)
270               End If
280               Response = acDataErrContinue
                  
290           Else
                  ' reopen list to force selection
300               Response = acDataErrContinue
                  
310           End If
320       End With
330       mvarLast = "*"

ExitHere:
340      On Error GoTo 0
350      Exit Sub

ErrorHandler:
360   Select Case Err
      Case 0
370      Resume Next
380   Case Else
390      LogError Err.Number, Err.Description, Erl, "mcboAny_NotInList", "clsComboSearch"
400      Resume ExitHere
410   End Select

          
End Sub

Private Sub mfrmClock_Timer()
      ' The form was idle for at least Me.TimeOut milliseconds
10       On Error GoTo ErrorHandler

20        If Len(Nz(mcboAny.Text, "")) >= Me.MinLenght Then
      'Debug.Print Now(), "mcboAny_Timer PerformSearch"
30            PerformSearch
40        ElseIf Nz(mcboAny.Text, "") = "" Then
      'Debug.Print Now(), "mcboAny_Timer ResetRowSource"
50            ResetRowSource
              ' reset time-out for on the fly searching
60            If Me.OnTheFly Then mfrmClock.TimerInterval = 0
70        End If

ExitHere:
80       On Error GoTo 0
90       Exit Sub

ErrorHandler:
100   Select Case Err
      Case 0
110      Resume Next
120   Case Else
130      LogError Err.Number, Err.Description, Erl, "mfrmClock_Timer", "clsComboSearch"
140      Resume ExitHere
150   End Select

End Sub

Function LogError(ByVal lngErrNumber As Long, ByVal strErrDescription As String, strLine As String, _
                  strCallingProc As String, Optional strCallingModule As String, Optional vParameters = "", Optional bShowUser As Boolean = True) As Boolean
10        On Error GoTo Err_LogError
          ' Purpose: Generic error handler.
          ' Logs errors to table "ErrorLog".
          ' Arguments: lngErrNumber - value of Err.Number
          ' strErrDescription - value of err.description
          ' strLine - code line number (Erl) Erl=0 if no row number in the line
          ' strCallingProc - name of sub|function that generated the error.
          ' strCallingModule - name of code module that generated the error.
          ' vParameters - optional string: List of parameters to record.
          ' bShowUser - optional boolean: If False, suppresses display.
          Dim strMsg As String                              ' String for display in MsgBox
20        Select Case lngErrNumber
              Case 0
30                Debug.Print strCallingProc & " called error 0."
40            Case 2501                                     ' Cancelled
                  'Do nothing.
50            Case 3314, 2101, 2115                         ' Can't save.
60                If bShowUser Then
70                    strMsg = "Record cannot be saved at this time." & vbCrLf & "Complete the entry, or press <Esc> to undo."
80                    MsgBox strMsg, vbExclamation, "Error"
90                End If
100           Case Else
110               If bShowUser Then
120                   strMsg = "Error " & lngErrNumber & " (" & strErrDescription & "), Line " & strLine & " in procedure " & _
                      strCallingProc & ", module " & strCallingModule
130                   MsgBox strMsg, vbExclamation, "Error " & Now()
140               End If
      '            Set rst = CurrentDb.OpenRecordset("ErrorLog", , dbAppendOnly)
      '            rst.AddNew
      '            rst![ErrNumber] = lngErrNumber
      '            rst![ErrDescription] = Left$(strErrDescription, 255)
      '            rst![ErrDate] = Now()
      '            rst![ErrLine] = strLine
      '            rst![CallingProc] = strCallingProc
      '            rst![CallingModule] = strCallingModule
      '            rst![UserName] = GetFullUserInfo()
      '            rst![ShowUser] = bShowUser
      '            If Not IsMissing(vParameters) Then
      '                rst![Parameters] = Left(vParameters, 255)
      '            End If
      '            rst.Update
      '            rst.Close
      '            LogError = True
      '
150       End Select
          

          
              
          
Exit_LogError:
      '    Set rst = Nothing
160       Exit Function
Err_LogError:
170       strMsg = "An unexpected situation arose in your program." & vbCrLf & _
                   "Please write down the following details:" & vbCrLf & vbCrLf & _
                   "Calling Proc: " & strCallingProc & vbCrLf & _
                   "Error Number " & lngErrNumber & " in line " & strLine & vbCrLf & strErrDescription & vbCrLf & vbCrLf & _
                   "Unable to record because Error " & Err.Number & " in line " & Erl & vbCrLf & Err.Description
180       MsgBox strMsg, vbCritical, "LogError()"
190       Resume Exit_LogError
End Function
Вопрос: Как при выборе записи в ComboBox, удалить ее с листа?

Как при выборе записи в ComboBox, удалить ее с листа?
Ответ: Вот есть небольшой пример, который у меня используется при поиске. Ввод значения поиска пишется в ComboBox, и потом его и запоминает в нем. Получается окно ввода с памятью.
Код пишется в метод Valid

*// Если ничего не введено, или пустое значение - ничего не происходит
IF EMPTY(This.Text) &&.OR. ALLTRIM(This.Text) = ALLTRIM(This.Value)
RETURN
ENDIF
WITH Thisform
NewPopup = .T. && Признак записи в ComboBox
*// Сканируем существующий список, если уже такое значение (разрешать нам добавлять в список или нет)
FOR nn = 1 TO This.ListCount
IF This.List(nn) = ALLT(This.Text)
*// если такое значение уже найдено в списке, то признак записи принимает .F.
NewPopup = .F.
ENDIF
ENDFOR
*// Если такого значения нет в списке то его добавляем
IF NewPopup = .T.
*// Ограничение количества записей в списке равное 20, если больше, то первая запись удаляется, а текущая добавляется
IF This.ListCount >= 20
This.RemoveItem(1) && удаляем первую запись
ENDIF
This.AddItem(This.Text) && добавляем новую запись к текущим
ENDIF

Получается тут есть и добавление записи и удаление. А порядковый номер записи, это его индекс.
Поиграйся с этой процедурой.
Вопрос: Проблема с BoundColumn в ComboBox

Доброго времени суток!
У меня возникла такая проблема: в RowSource ComboBox есть два поля курсора (curZap2.NomU,UchName); я хочу, чтобы при выборе значения из списка в Value ComboBox попадало значение UchName, а не NomU. Для этого поставил BoundColumn в 2, но результат всё равно не меняется. Как это исправить?
Ответ: В ComboBox всегда выводится первре зхначение, если используется много колоночные свойства. В BoundColumn указывается по коаой колонке из таблице связывается контроль. Для получения данных из второй колонки, восподьзуетесь соммандой .Combo1.ListItem(.Combo1.ListIndex,2) Control.ListItem(nRow [, nCol])[ = cChar]
Вопрос: Динамический ввод в combobox

Добрый день. Подскажите как можно организовать динамический ввод слов в Combobox например: ввожу в combo Пет а он предлагает Петров?
Ответ: IgorNG, IncrementalSearch ставлю .t. но ни чего не меняется к форме подключен курсорадаптер а в свойстве combobox RowSourse выбран нужный столбец из таблицы тип Rowsourse Alias. Может я чтото делаю не так? В combobox данные отображаются.
Вопрос: Поле со списком авто подстановка с конца

Доброго времени суток!
Есть ли такая возможность вводя данные в поле со списком, список начал поиск введенных данных с конца. Т.е. - У меня есть поле со списком, привязанный к таблице списка вин номеров автомобилей (17 символов). Начало их одинаковые (7-14символов), список достаточно большой и чтобы дойти до нужного, нужно ввести почти весь вин номер. Так вот мне надо, что бы он формировал его по последним цифрам, вводя 4-6 цифр окончания вин номера.
Ответ: Удобно сделать список и поисковое поле, фильтрующееся по мере ввода символов. Фильтр сделан на событии Change (Изменение) поискового поля fldPoisk в форме ПоискVIN. Фильтр на основе изменения запроса-источника списка VIN. Смотрите пример. Можете набирать любую комбинацию. Если такие есть в исходном наборе, они отразятся в фильтрующемся списке. Код в модуле формы на событии Change поля fldPoisk.

В модуле Module1 процедура генерации фиктивных номеров VIN в таблицу VIN.
Вопрос: Как заполнить combobox

В init формы пишу
thisform.combo_u1.RowSourceType = 0
thisform.combo_u1.AddItem("Все")
Но на форме появляется пустой  combobox, 
тогда дописываю
thisform.combo_u1.DisplayValue=

Конечно можно написать "Все", но хотелось бы вывести первый элемент списка по индексу списка..
Далее, мне хотелось бы создать combobox с двумя полями id и наименование, но id не должен быть виден в списке и потом добавить значения из таблицы(30 записей)
И последнее, когда выберу какое-нибудь значение, чтоб вышло сообщение messagebox(id, наименование, и номер индекса в списке)..
Не могу вспомнить как это делается...
Ответ: спасибо, правда в этом классе я что-то не увидел метод onclick, чтоб messagebox показался..
Вопрос: Установка начального значения ComboBox, источник данных курсор

Имеется ComboBox со следующими свойствами:
1). BoundColumn = 2
2). BoundTo = .T.
3). RowSource = lcAlias
4). RowSourceType = 2 (Alias)


В качестве источника данных используется курсор (формируется в методе load формы, на которой размещен ComboBox):
SELECT name, code FROM source_table INTO CURSOR lcAlias

, где типы полей
name c(60), code n(4)
.

После запуска формы, ComboBox содержит нужный список значений, но не отображает начальное значение. Пробую его установить:

lnInitValueForCom1 = VAL(lcCode)
thisform.pageframe1.page1.combo1.Value = lnInitValueForCom1

, где
lcCode (с(4))- параметр переданный в форму, и соответствующий одному из значений списка.
Итог - не работает. При этом команда
messagebox(lnInitValueForCom1)
отображает например значение 1230 (и тип "n"), но если заменить на
lnInitValueForCom1 = 1230
, то ComboBox отображает нужное значение при старте формы.

Почему не работает отображение начального значения, когда переменная lnInitValueForCom1 задана как VAL(lcCode)?
Ответ: Да, тут лишняя, мой косяк.
Вопрос: Проблема combobox

Добрый день!
Не могу решить проблему с комбобоксом. Access 2003, WinXP и Win7
Создаю на форме combobox. Данные - запрос ID, FIO, Birthday, ID - 0 ширины
Начинаю писать "Ива" - в поле первая из списка Иванова, другие Ивановы идут следом. Всё работает отлично, пока не закрыть и вновь открыть БД.
После повторного открытия БД вводишь "Ива" - в поле "Ива", при раскрытии списка - в верхнем положении, при выходе из контрола - "Введённый текст не соответствует ни одному элементу списка".
Глюк, фича или моё недопонимание?
Ответ: Проблема в галочке ansi 92
Как из этой ситуации выйти - не понимаю
В большой базе некоторые таблицы - из sql server

К сообщению приложен файл (db3.rar - 8Kb)
Вопрос: О типе comboBox

Есть у меня на форме combobox, по русски - поле со списком. Первоначально присоединённый столбец был в символьном виде. Потом я его переделал на числовой. Но комбобокс всё равно выдаёт значения в текстовом виде: т.е. вместо 3, 5, 11 он выдаёт "3", "5", "11". Как ему мозги вправить? Что надо сделать, чтоб он выдавал значения в числовом виде?


-------------------------------------------------------------
А ты вложил уже свой кровный рубль в 50-ти миллиардное состояние Билла Гейтса?
Ответ: Панург, спасибо за ссылку, если есть решение-"Как", можно вроде не заниматься вопросом "Почему".
Я вчера вроде прикладывал файл примером - куда-то испарился. Пробую ещё раз. На форме нажимаем последовательно КБ0, КБ2,КБ4.
Результат виден. С помощью BoundColumn=0 можно объехать. Что интересно (или не очень?) - Me.Requery на первых двух КБ не приводит к смене типа, а КБ3 - приводит. "Как-то не очень" исследовать форму какие Requery будут корёжить комбобоксы на больших формах

К сообщению приложен файл (KB.7z - 22Kb)
Вопрос: ComboBox и несколько значений

При создании в таблице поля с выпадающим списком есть возможность поставить "Разрешить несколько значений - Да".
Но как работать с этим полем? как программно узнать что выбрано в кобобоксе?

Мне нужно для формирования отчета. Если на форме Комбо пустой, то отчет по всем Заказчикам, если выбран один или несколько, то по выбранным.

Может альтернатива комбобоксу с несколькими значениями какая есть ?
Ответ: прошу пардон-забыл IN
да и переменную mydate можнео убрать,заменив my
DoCmd.OpenReport "ИмяОтчет", acViewPreview, , "полеОтбора  in  " & my