如何确定在 Access VBA 中键入组合框和从下拉列表中选择之间的区别？

Posted 2023-05-07

【中文标题】如何确定在 Access VBA 中键入组合框和从下拉列表中选择之间的区别？

【英文标题】：How can I determine the difference between typing into a combo box and selecting from a drop down in Access VBA?

【发布时间】：2016-01-14 05:19:33

【问题描述】：

早先在topic with a similar name 中提出了这个问题，但提供的答案并未真正表明这些事件将如何帮助确定有人在组合框中键入内容还是选择列表中的项目。我认为它确实回答了另一个关于如何确定某人何时完成输入的问题，但没有看到事件处理程序，我无法确定。

不幸的是，我是新来的，没有足够的声誉发表评论要求澄清，所以我必须提出一个新问题。这是我正在尝试做的事情：

我有一个在标题中带有组合框的表单，当我在组合框中键入时，我希望将我键入的字符用作表单详细信息部分的过滤器。组合框控件源和表单的记录源都使用相同的查询字符串。

我已经尝试了下面代码的多次迭代，但我无法让它正常工作。

Private Sub cmbAppName_Change()
    Dim strApp As String
    Dim nSelStart As Integer
    Dim nSelLen As Integer
    Dim nSelected As Integer
    Dim strMsg As String

    On Error GoTo ERR_SUB

    strMsg = ""

    Me.cmbAppName.SetFocus

    ' Get current selection details
    nSelStart = Me.cmbAppName.SelStart
    nSelLen = Me.cmbAppName.SelLength
    nSelected = Me.cmbAppName.ListIndex

    Me.cmbAppName.SetFocus
    strApp = Nz(Me.cmbAppName.Text, "")

    Debug.Print "Index = " & nSelected & "; SelStart = " & nSelStart & "; SelLen = " & nSelLen
    If nSelected = -1 Then
        Debug.Print "Change by typing:  " & strApp
    Else
        Debug.Print "Change by list selection:  " & strApp
    End If

    ' Get the part of the text that the user has typed
    If nSelStart > 0 Then
        strApp = Left(strApp, nSelStart)
        Debug.Print "App piece = '" & strApp & "'"
    End If

    ' If there is text, set a filter (MatchAppName = InStr(strApp, datbase_column_value)
    If strApp <> "" Then
        Me.Filter = "MatchAppName('" & strApp & "', " & DCApplications_Application_Col & ") > 0"
        Me.FilterOn = True
'        Me.txtApplication.SetFocus
'        Call DoCmd.FindRecord(strApp, acStart, False, acSearchAll, False, acCurrent, True)
'        Me.cmbAppName.SetFocus
    Else
        Me.Filter = ""
        Me.FilterOn = False
    End If

EXIT_SUB:
    ' Restore the selection in the combo box's text box
    Me.cmbAppName.SetFocus
    Me.cmbAppName.SelStart = nSelStart
    Me.cmbAppName.SelLength = nSelLen
    Exit Sub

ERR_SUB:
    If ERR.Number = 2185 Then
        strApp = Nz(Me.cmbAppName.Value, "")
        Me.cmbAppName.SetFocus
        Debug.Print "Using " & strApp
        Resume Next
    End If

    Me.Filter = ""
    Me.FilterOn = False
    Debug.Print ErrorMessage(ERR.Description, "cmbAppName_Change", ERR.Number, "Value = '" & Me.cmbAppName.Value & "'", False)
    Resume EXIT_SUB
End Sub ' cmbAppName_Change

正如您从错误处理代码中看到的那样，我经常收到错误 2185，告诉我在使用 Text 属性时我的控件没有焦点，尽管它之前有一个 SetFocus 调用。

如果有人从列表中选择（通过单击或移动选择），我想转到该记录，但我至少需要先完成上述工作。

【参考方案1】：

在网上搜索后，我发现有零记录的详细信息部分会导致 2185 错误。显然，当过滤掉所有记录时，这样的过滤会导致问题。

Web 上的解决方案说您可以将表单的 Allow Additions 属性设置为 True，但始终在 Details 部分显示一行。如果详细信息部分中的行包含将显示在“添加”行中的控件，这可能会特别令人困惑。此外，在导致“详细信息”部分的记录为零的字符之后，我仍然会输入其他字符时出错。

最后，我用一个简单的文本控件替换了组合框来过滤“详细信息”部分。当 Details 部分有行时，我关闭 Allow Additions 并使控件可见；当它没有行时，我打开允许添加并隐藏控件。

这是我使用的代码：

Private Sub txtApplicationFilter_Change()
    Dim strApp As String
    Dim nSelStart As Integer
    Dim nSelLen As Integer
    Dim strFilter As String
    Dim strQuery As String
    Dim strWhere As String
    Dim nRecs As Integer
    
    On Error GoTo ERR_SUB
    
    ' Save text selection
    nSelStart = Me.txtApplicationFilter.SelStart
    nSelLen = Me.txtApplicationFilter.SelLength
   
    ' Get application name typed and selection information
    strApp = Nz(Me.txtApplicationFilter.Text, "")
    strFilter = "[" & DCApplications_Application_Col & "] LIKE '*" & EscapeQuotes(strApp) & "*'"
    nRecs = DCount("[" & DCApplications_Application_Col & "]", LocalTableName(DCApplications_Tab), strFilter)

    ' Kludge code to prevent various errors (like 2185) when no records are returned in the form
    Call UpdateList(nRecs)
    
    ' Update the record source to reflect the filtered list of apps
    strWhere = " WHERE APPS." & strFilter
    strQuery = strSelect & strFrom & strWhere & strOrderBy
    Me.RecordSource = strQuery

    ' 20200423 SHM: Restore or update filter to avoid  issues with Delete and Backspace and applications with spaces in their names
    Me.txtApplicationFilter.SetFocus
    Me.txtApplicationFilter = strApp
    Me.txtApplicationFilter.SelStart = nSelStart
    Me.txtApplicationFilter.SelLength = nSelLen

EXIT_SUB:
    Me.btnAddNew.enabled = (Nz(Me.txtApplicationFilter, "") <> "")
    Exit Sub
    
ERR_SUB:
    ' NOTE:  ErrorMessage is a helper function that basically displays a form displaying the error
    Call ErrorMessage(ERR.Description, "txtApplicationFilter_Change", ERR.Number, "Filter = " & strApp & " Records = " & nRecs)
    
    Resume EXIT_SUB
    Resume Next
End Sub ' txtApplicationFilter_Change

Private Sub UpdateList(nRecs As Integer)
    Dim bShowControls As Boolean
    
    On Error GoTo ERR_SUB
    
    bShowControls = (nRecs > 0)
    
    ' Kludge code to turn off checkbox control source
    If bShowControls Then
        strSelect = strSelectStart & ", (" & strAppUser & ") AS " & strCtrlSource
        Me.chkTestedByMe.ControlSource = strCtrlSource
    Else
        strSelect = strSelectStart
        Me.chkTestedByMe.ControlSource = ""
    End If
    
    ' Kludge code to prevent various errors (like 2185) when no records are returned in the form
    ' Turning on AllowAdditions prevents errors when no records are returned.
    ' However, that puts an empty row in the form, but the controls are showing, so we have to hide them to prevent confusing the user.
    Me.AllowAdditions = Not bShowControls
    Me.btnAddExisting.visible = bShowControls
    Me.chkTestedByMe.visible = bShowControls
EXIT_SUB:
    Exit Sub
    
ERR_SUB:
    Call ErrorMessage(ERR.Description, "UpdateList", ERR.Number, " Records = " & nRecs)
    
    Resume EXIT_SUB
    Resume Next
End Sub ' UpdateList

【参考方案2】：

我会使用变通方法来解决这个问题

下面的一个简单代码演示了使用组合框的 Tag 属性和 keypress 事件 以及 change 事件 的工作，我希望它可以应用到您的代码中

Private Sub Combo2_Change()
    If Combo2.Tag = 1 Then
        Text4 = "change - from key"
    Else
        Text4 = "change - from select"
    End If
    Combo2.Tag = 0
End Sub

Private Sub Combo2_KeyPress(KeyAscii As Integer)
    Combo2.Tag = 1
End Sub

不要忘记在设计视图中将组合框的标签属性设置为 0，以避免在比较空标签与数字时出错