为啥 Access VBA 下拉方法不起作用？

Posted 2023-05-07

【中文标题】为啥 Access VBA 下拉方法不起作用？

【英文标题】：Why does Access VBA dropdown method not work?为什么 Access VBA 下拉方法不起作用？

【发布时间】：2018-12-06 18:11:35

【问题描述】：

我在 Access 2013 中使用文本框过滤组合框列表。我将过滤器代码放在 Form_Timer 子中，以便让用户有时间在应用过滤器之前键入整个过滤器字符串，然后我调用文本框中的计时器更改子。它很好用，除了一件事：我希望组合框列表下拉并显示结果，但它不起作用。但是，我将完全相同的代码行放在组合框的 GotFocus 子中，并且该行完美运行。

我还尝试在 Change 子程序中执行过滤器代码，以防 Form_Timer 执行出现一些奇怪的情况。结果相同。代码如下：

Private Sub cboCENamesMain_GotFocus()

    Me.cboCENamesMain.Dropdown '<---This line works perfectly.

End Sub

Private Sub Form_Timer()

    Dim strSQL As String

    Me.TimerInterval = 0
    Me.txtFilter.Value = Me.txtFilter.Text
    Me.cboCENamesMain.SetFocus

    strSQL = ""
    strSQL = strSQL & "Select DISTINCT [CE ID] "
    strSQL = strSQL & "From [tblMyTable] "
    If Len(Me.txtFilter) > 0 Then
        strSQL = strSQL & "Where [CE ID] Like ""*" & Me.txtFilter & "*"" "
    End If
    strSQL = strSQL & "Order By [CE ID];"

    Me.cboCENamesMain.RowSource = strSQL

    Me.cboCENamesMain.Dropdown '<---This line doesn't do what it's supposed to.
    Me.txtFilter.SetFocus
    Me.txtFilter.SelStart = Len(Me.txtFilter.Text)
    Me.txtFilter.SelLength = 0

End Sub

Private Sub txtFilter_Change()

    If Len(Me.txtFilter.Text) = 0 _
    Or Len(Me.txtFilter.Text) > 2 Then
        Me.TimerInterval = 500
    End If

End Sub

我可以使用列表框而不是组合框来允许用户查看他们的过滤输入结果，但这会严重影响我的表单设计。我在 Google 和 *** 上搜索过，但没有找到其他人讨论这个问题。有什么想法吗？

【问题讨论】：

您的代码对我来说毫无意义。您不能在下拉组合框的同时在文本字段中进行选择，因为这两个操作都需要将焦点放在控件上。该行可能工作正常，但在它再次折叠下拉菜单后立即行。

谢谢 Erik - 你是对的，当然，我应该想到这一点。我删除了下拉行后面的代码，然后它就可以工作了。只是这需要用户非常快速地输入他们的过滤文本——恐怕两个手指打字员可能会觉得这很令人沮丧。我知道我过去成功地完成了这种事情，但不记得我是如何做到的 - 我会再考虑一下。

好吧，现在我觉得很傻。我从组合框 Change sub 而不是文本框运行计时器，它按我想要的方式工作。不需要文本框 - 仅用于过滤列表框。我只需要将组合框自动展开属性更改为否，以避免 Access 填写匹配项。

通过Me.cboCENamesMain.Dropdown 调用，您是否希望强制MS Access 填充组合框的列表部分？也许Me.cboCENamesMain.Requery 是更好的选择？

可能下拉菜单不起作用，因为您已经移动了焦点。将 me.txtFilter 内容移动到 cboCeNamesMain 的 AfterUpdate。 （然后你就不需要那个 gotfocus 电话了）

【参考方案1】：

这是我的最终代码。这正是我想要的方式。用户键入几个字符，计时器会自动将组合框列表过滤到包含键入字符串的项目。

*** 是提交此类文件的好地方 - 从一个工作到另一个工作，它将节省一些重新发明***的时间。

代码中的大量 cmets 是为我的合同结束后需要维护应用程序的分析师准备的。他们俩都没有写过 VBA。

Private Sub cboCENamesMain_Change()

    ' Ordinarily the AfterUpdate event would automatically fire off the Change event.
    ' We set a flag to avoid that - otherwise the list would be filtered to only the selected record.
    If booCancelChange = False Then
        ' Don't bother filtering the combo box list unless the filter text is null or longer than
        ' 1 character.
        If Len(Me.cboCENamesMain.Text) <> 1 Then
            ' Set the Form_Timer event to fire off in 0.3 second to give them time to type a few characters.
            Me.TimerInterval = 300
        End If
    Else
        ' Reset the flag, otherwise the Change code would stop working after the first record selection.
        booCancelChange = False
    End If

End Sub

Private Sub Form_Timer()

    Dim strSQL As String

    ' Reset the timer to not fire off, so that it won't keep running without a change
    ' in the combo box.
    Me.TimerInterval = 0

    ' If they have tabbed out of the combo box after selecting an item, we don't want to
    ' do this.  It's unnecessary and it throws errors from references to the control's
    ' properties when focus is no longer on the control.
    If Screen.ActiveControl.Name = Me.cboCENamesMain.Name Then
        ' Create a SQL filter for the combo box using the entered text.
        strSQL = ""
        strSQL = strSQL & "Select DISTINCT [CE ID] "
        strSQL = strSQL & "From [Covered Entities] "
        If Len(Me.cboCENamesMain.Text) > 0 Then
            strSQL = strSQL & "Where [CE ID] Like ""*" & Me.cboCENamesMain.Text & "*"" "
        End If
        strSQL = strSQL & "Order By [CE ID];"

        ' Apply the filter.
        Me.cboCENamesMain.RowSource = strSQL
        Me.txtRowCount = Me.cboCENamesMain.ListCount
        ' Drop down the combo list so they can see the results of their filter text.
        Me.cboCENamesMain.Dropdown
    End If

End Sub