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

Posted 2023-02-24

【中文标题】如何根据用户类型用相似的记录重新填充组合框

【英文标题】：How to refill combobox with similar records based on what user types

【发布时间】：2019-07-27 18:10:21

【问题描述】：

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

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

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

我正在考虑使用用户在组合框中键入的内容，而我的 VBA 代码将获取“更改事件”并通过使用他们的输入作为新查询的 like 条件即时重新查询组合框。

这是一条可能的路线吗？会不会慢一些？有更好的路线吗？

我希望有人可以展示一些示例，说明如何实现我的目标。

【问题讨论】：

您使用 LIKE 和 * 通配符的想法应该可行，但性能可能不会完全令人满意。查看最近关于实现代码以管理组合框accessforums.net/showthread.php?t=77740 的讨论。必须修改代码以生成 LIKE *string* 的语法并反复更改 RowSource 属性。

【参考方案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

代码来源于此链接：

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

【讨论】：

抱歉这么久才回复。我只想感谢你的回答。我能够完成我想要的。