如何根据用户类型用相似记录重新填充组合框

Question

我目前正在构建一个表单，用户可以在其中根据描述或部件号查找工具。

我希望用户能够在组合框中键入任何字母，这些字母已绑定到列出我所有工具的查询，并且组合框将使用与其组合框中存在的最相似的工具重新填充自身。例如，如果他们开始输入 wre，那么具有相似字符的工具将开始出现在组合框中，例如 wrench、torque wrench、power wrench 等

我尝试四处寻找其他人对此的解决方案，但要么我没有完全理解现有的解决方案（我对 Access 还很陌生），要么这不是我想要的。我看到有人建议改用列表框，但我真的不想走那条路。

我正在考虑使用用户在组合框中键入的内容，我的 VBA 代码将获取 "change event" 并通过使用他们的输入作为 [=14] 即时重新查询组合框=] 新查询的条件。

这是可行的路线吗？会不会更慢？有更好的路线吗？

我希望有人可以展示一些关于如何实现我正在寻找的东西的例子。

Answer 1

键入时搜索功能非常有用！使用文本框和列表框，您可以设置一个动态搜索工具，该工具将在您键入时过滤列表以进行近似匹配。文本框有四个与之关联的事件，如此处所示。

表单背后的代码如下所示。注意粗体部分。这是我们创建一串 SQL 命令的地方，并利用 SQL Like 运算符在我们键入时获得动态匹配。注意下面加粗的文字。

Option Compare Database
Option Explicit On

Private blnSpace As Boolean  'INCLUDE THIS LINE ON YOUR FORM

Private Sub btnClearFilter_Click()
    'CODE FOR THE RED "X" BUTTON TO CLEAR THE FILTER AND SHOW ALL
    On Error Resume Next
    Me.txtSearch.Value = ""
    txtSearch_Change()
End Sub

Private Sub txtSearch_Change()
    'CODE THAT HANDLES WHAT HAPPENS WHEN THE USER TYPES IN THE SEARCH BOX
    Dim strFullList As String
    Dim strFilteredList As String


    If blnSpace = False Then
        Me.Refresh 'refresh to make sure the text box changes are actually available to use

        'specify the default/full rowsource for the control
        strFullList = "SELECT RecordID, First, Last FROM tblNames ORDER BY First;"

        'specify the way you want the rowsource to be filtered based on the user's entry
        strFilteredList = "SELECT RecordID, First, Last FROM tblNames WHERE [First] LIKE ""*" & Me.txtSearch.Value &
                          "*"" OR [Last] LIKE ""*" & Me.txtSearch.Value & "*"" ORDER BY [First]"

        'run the search
        fLiveSearch Me.txtSearch, Me.lstItems, strFullList, strFilteredList, Me.txtCount
    End If

End Sub

Private Sub txtSearch_KeyPress(KeyAscii As Integer)
    'NECESSARY TO IDENTIFY IF THE USER IS HITTING THE SPACEBAR
    'IN WHICH CASE WE WANT TO IGNORE THE INPUT

    On Error GoTo err_handle

    If KeyAscii = 32 Then
        blnSpace = True
    Else
        blnSpace = False
    End If


    Exit Sub
err_handle:
    Select Case Err.Number
        Case Else
            MsgBox "An unexpected error has occurred: " & vbCrLf & Err.Description &
                  vbCrLf & "Error " & Err.Number & "(" & Erl() & ")"
   End Select
End Sub
Private Sub txtSearch_GotFocus()
    ' USED TO REMOVE THE PROMPT IF THE CONTROL GETS FOCUS
    On Error Resume Next
    If Me.txtSearch.Value = "(type to search)" Then
        Me.txtSearch.Value = ""
    End If
End Sub
Private Sub txtSearch_LostFocus()
    ' USED TO ADD THE PROMPT BACK IN IF THE CONTROL LOSES FOCUS
    On Error Resume Next
    If Me.txtSearch.Value = "" Then
        Me.txtSearch.Value = "(type to search)"
    End If

End Sub

最后，在常规模块中，您将需要此脚本。

Option Compare Database
Option Explicit On

'************* Code Start **************
' This code was originally written by OpenGate Software
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
' OpenGate Software    http://www.opengatesw.net

Function fLiveSearch(ctlSearchBox As TextBox, ctlFilter As Control,
                      strFullSQL As String, strFilteredSQL As String, Optional ctlCountLabel As Control)
    Const iSensitivity = 1 'Set to the number of characters the user must enter before the search starts
    Const blnEmptyOnNoMatch = True 'Set to true if you want nothing to appear if nothing matches their search


    On Error GoTo err_handle

    'restore the cursor to where they left off
    ctlSearchBox.SetFocus
    ctlSearchBox.SelStart = Len(ctlSearchBox.Value) + 1

    If ctlSearchBox.Value <> "" Then
        'Only fire if they've input more than two characters (otherwise it's wasteful)
        If Len(ctlSearchBox.Value) > iSensitivity Then
            ctlFilter.RowSource = strFilteredSQL
            If ctlFilter.ListCount > 0 Then
                ctlSearchBox.SetFocus
                ctlSearchBox.SelStart = Len(ctlSearchBox.Value) + 1
            Else
                If blnEmptyOnNoMatch = True Then
                    ctlFilter.RowSource = ""
                Else
                    ctlFilter.RowSource = strFullSQL
                End If
            End If
        Else
            ctlFilter.RowSource = strFullSQL
        End If

    Else
        ctlFilter.RowSource = strFullSQL
    End If

    'if there is a count label, then update it
    If IsMissing(ctlCountLabel) = False Then
        ctlCountLabel.Caption = "Displaying " & Format(ctlFilter.ListCount - 1, "#,##0") & " records"
    End If

    Exit Function
err_handle:
    Select Case Err.Number
        Case 91 'no ctlCountLabel
       'exit
        Case 94 'null string
            'exit
        Case Else
            MsgBox "An unexpected error has occurred: " & vbCrLf & Err.Description &
               vbCrLf & "Error " & Err.Number & vbCrLf & "Line: " & Erl()
   End Select

End Function

代码来自这个link:

http://www.opengatesw.net/ms-access-tutorials/Access-Articles/Search-As-You-Type-Access.html

如何根据用户类型用相似记录重新填充组合框

How to refill combobox with similar records based on what user types

vba

ms-access

combobox

ms-access-forms