搜索框不允许我在单词之间键入空格

Question

我在一个表单上有一个文本框，它根据公司名称过滤我的数据。在错误处理中使用关闭和打开代码的原因是，当输入不存在的字符组合时，我找不到一种容易修复的方法来抛出错误。这种方式只是关闭和重新打开它，基本上重置它。我对这种发展还是相当陌生的，我所知道的一切都是通过谷歌和像这样的论坛教给我的，所以请原谅我缺乏理解，当事情应该对其他人有意义时能够做这些类型的功能。

在键入公司名称的一部分并按空格键键入第二个单词时，它实际上是删除空格并将光标放回到最后键入的字母上。

这是文本框的代码。

提醒我，我找到了我需要的功能的解决方案，并尽我所能调整代码以满足我的需求。我还不能假装完全理解我使用的东西，我还在学习。

Private Sub txtSearch_KeyUp(KeyCode As Integer, Shift As Integer)
On Error GoTo errHandler
Dim filterText As String

'Apply or update filter based on user input.
If Len(txtSearch.Text) > 0 Then
filterText = txtSearch.Text
Me.Form.Filter = "[tblSuppliers]![SupplierName] like '*" & filterText & "*'"
Me.FilterOn = True

'Retain filter text in search box after refresh
txtSearch.Text = filterText
txtSearch.SelStart = Len(txtSearch.Text)
Else
'Remove filter
Me.Filter = ""
Me.FilterOn = False
txtSearch.SetFocus
End If

Exit Sub
errHandler:
MsgBox Err.Number & " - " & Err.Description, vbInformation + vbOKOnly, "Information"
DoCmd.Close acForm, "frmCosteeDetails", acSaveNo
DoCmd.OpenForm "frmCosteeDetails"
End Sub

在我的搜索中，试图找到一种方法来修复空格的删除，我发现有人列出了这个函数，但不确定如何将其集成到我的代码中。

Public Function FindWord(varFindIn As Variant, varWord As Variant) As Boolean
Const PUNCLIST = """' .,?!:;(){}[]/"
Dim intPos As Integer
FindWord = False
If Not IsNull(varFindIn) And Not IsNull(varWord) Then
intPos = InStr(varFindIn, varWord)
' loop until no instances of sought substring found
Do While intPos > 0
' is it at start of string
If intPos = 1 Then
' is it whole string?
If Len(varFindIn) = Len(varWord) Then
FindWord = True
Exit Function
' is it followed by a space or punctuation mark?
ElseIf InStr(PUNCLIST, Mid(varFindIn, intPos + Len(varWord), 1)) > 0 Then
FindWord = True
Exit Function
End If
Else
' is it precedeed by a space or punctuation mark?
If InStr(PUNCLIST, Mid(varFindIn, intPos - 1, 1)) > 0 Then
' is it at end of string or followed by a space or punctuation mark?
If InStr(PUNCLIST, Mid(varFindIn, intPos + Len(varWord), 1)) > 0 Then
FindWord = True
Exit Function
End If
End If
End If
' remove characters up to end of first instance
' of sought substring before looping
varFindIn = Mid(varFindIn, intPos + 1)
intPos = InStr(varFindIn, varWord)
Loop
End If
End Function

编辑当前方案代码

Private Sub txtSearch_Change()
On Error GoTo errHandler

'clear filter
If Len(txtSearch.Text) = 0 Then
FilterOn = False
Filter = vbNullString
Exit Sub
End If

'apply filter
Filter = "[SupplierName] like '*" & txtSearch.Text & "*'"
FilterOn = True

Leave:
Exit Sub
errHandler:
MsgBox Err.Number & " - " & Err.Description, vbInformation + vbOKOnly, "Information"
Resume Leave

'DoCmd.Close acForm, "frmCosteeDetails", acSaveNo
'DoCmd.OpenForm "frmCosteeDetails"
End Sub

Answer 1

一个简单的过滤器方法如下所示。您需要处理Change()事件并使用Text属性，该属性在每次击键时填充。

另外，过滤不需要查询数据，因此不需要尝试手动保留搜索值。

下面假设txtSearch和要过滤的数据在同一表单上。如果不是这种情况，则需要更改对数据表单的引用。

Private Sub txtSearch_Change()
On Error GoTo errHandler

'clear filter
If Len(txtSearch.Text) = 0 Then
FilterOn = False
Filter = vbNullString
Exit Sub
End If

'apply filter
Filter = "[SupplierName] like '*" & txtSearch.Text & "*'"
FilterOn = True

Leave:
Exit Sub
errHandler:
MsgBox Err.Number & " - " & Err.Description, vbInformation + vbOKOnly, "Information"
Resume Leave
End Sub 

Answer 2

与其使用文本框不断更新，不如将其更改为搜索按钮，当单击时根据搜索框中的值进行搜索。您所要做的就是每次更新搜索条件并单击"搜索"。稍微慢一点，但功能基本相同。

Private Sub cmdSearch_Click()
Dim strWhere As String

strWhere = "[tblSuppliers]![SupplierName] Like '*" & Me.txtSearch & "*'"

'Apply Filter
Me.Filter = strWhere
Me.FilterOn = True
End Sub