访问VBA：从列表框输入文本框时搜索[重复]

Question

我有一个文本框，我想从一个从表格中填充的列表框中进行搜索。我希望列表框找到用户在文本框中键入的项目。这是我写的代码。文本框名称 = textSearch 和列表框名称 = lstAvailable。谁能帮帮我？

  Dim lngBoxLength As Long
  Dim intRow As Integer
  Dim strTextBox As String
  strTextBox = textSearch.Text
  lngBoxLength = Len(textSearch.Text)

  For intRow = 0 To lstAvailable.ListCount - 1
  If Left(lstAvailable.Column(1, intRow), lngBoxLength) = strTextBox Then
  lstAvailable.Selected(intRow) = True
  Exit For
  Next intRow
  end if 
  end sub

Answer 1

如果您的列表框具有如下行源：

    SELECT CustomerID, CompanyName, Phone, Fax FROM Customers ORDER BY CustomerID

然后使用类似于以下的代码隐藏：

'Search string for the list box.
Private strLstSearch As String

' Listing A
Private Sub SetTyped()
  'Display current typed or selected value.
  Me!txtSearch.Value = strLstSearch
End Sub

' Listing B
Private Sub lstPhone_KeyPress(KeyAscii As Integer)
  'Select item in list box
  Dim lst As ListBox
  Dim rst As ADODB.Recordset
  Dim lngKeyLen As Long
  Dim booReset As Boolean
  Set lst = Me.ActiveControl
  'Determine keyboard input
  'and respond accordingly.
  Select Case KeyAscii
    Case vbKeyBack
      'Cancel last key press.
      lngKeyLen = Len(strLstSearch)
      If lngKeyLen > 0 Then
        strLstSearch = Left(strLstSearch, lngKeyLen - 1)
        If lngKeyLen = 1 Then
          'Search string is empty. Reset listbox.
          booReset = True
        End If
      End If
    Case vbKeyEscape
      'Reset search string and listbox.
      strLstSearch = vbNullString
      booReset = True
    Case vbKeyReturn, vbKeyTab
    'Keeps Tab and Enter from being trapped.
    Case Else
      'Set search string value
      strLstSearch = strLstSearch & Chr(KeyAscii)
      'Inhibit normal stepping in listbox.
      KeyAscii = 0
  End Select
  lngKeyLen = Len(strLstSearch)
  If booReset = True Then
    'Reset listbox.
    lst.Value = lst.ItemData(Abs(lst.ColumnHeads))
  ElseIf lngKeyLen > 0 Then
    'Search listbox using the rowsource.
    Set rst = New ADODB.Recordset
    rst.Open lst.RowSource, CurrentProject.Connection, _
      adOpenStatic, adLockPessimistic
    With rst
      If .RecordCount > 0 Then
        .Find "CustomerID Like '" & strLstSearch _
         & "*'"
        If .EOF Then
          'Skip key entry and notify user.
          strLstSearch = Left(strLstSearch, lngKeyLen - 1)
          DoCmd.Beep
        Else
          'Set listbox to located match.
          lst.Value = .Fields(lst.BoundColumn - 1).Value
        End If
      End If
      .Close
    End With
  End If
  'Display current value.
  Call SetTyped
  Set rst = Nothing
  Set lst = Nothing

ExitHere:
  Set rst = Nothing
  Set lst = Nothing
  Exit Sub

ErrHandler:
  MsgBox Err.Number & " " & Err.Description
  GoTo ExitHere

End Sub

' Listing C
Private Sub lstPhone_Click()
  'Select item clicked on.
  strLstSearch = Me.ActiveControl.Value
  Call SetTyped
End Sub

' Listing D
Private Sub lstPhone_GotFocus()
  'Reset search string.
  strLstSearch = vbNullString
  Call SetTyped
End Sub

' Listing E
Private Sub lstPhone_LostFocus()
  'Reset search string.
  strLstSearch = vbNullString
  Call SetTyped
End Sub

如果您使用的是 DAO，请对代码进行以下更改：

1. 列表项

2. 添加以下声明和定义语句：

   Dim dbs As DAO.Database

   Dim rst As DAO.Recordset

   设置 dbs = CurrentDB

3. 删除 ADODB 记录集声明和定义语句。

4. 将 rst.Open 语句替换为以下语句：

   设置 rst = dbs.OpenRecordset(lst.RowSource)

5. 将 Find 方法替换为 FindFirst。

6. 将 .EOF 属性替换为 .NoMatch。