访问VBA:从列表框中键入文本框时搜索

时间:2018-04-18 10:27:34

标签: ms-access access-vba ms-access-2010 ms-access-2007 ms-access-2016

我有文本框,我想从列表框中搜索从表中填充的内容。我希望列表框能够找到用户在文本框中输入的项目。这是我写的代码。文本框名称= 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

1 个答案:

答案 0 :(得分:0)

如果您的Listbox包含如:

这样的行源
    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作为DAO.Database

    Dim rst as DAO.Recordset

    设置dbs = CurrentDB

  3. 删除ADODB Recordset声明和定义语句。

  4. 使用以下语句替换rst.Open语句:

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

  5. 将Find方法替换为FindFirst。

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