以编程方式更改源列表时如何防止执行下拉列表答案

【问题标题】：How to prevent dropdown from executing when source list is changed programmatically以编程方式更改源列表时如何防止执行下拉列表
【发布时间】：2016-10-04 11:07:05
【问题描述】：

我的电子表格上有一个 activeX 下拉表单，它在 _Change 上执行代码。我的代码修改了下拉列表源（添加或删除项目）。每当发生这种情况时，都会再次调用 _Change。

我有各种解决方法，所有这些都是更改列表源的某个版本，但没有成功。这一切都不起作用的原因是清除或更改.ListFillRange 实际上会再次触发_Change 事件。

如果我想在.ListFillRange 中添加或删除项目，如何防止_Changeevent 被调用

更新 w EnableEvents 设置为 false：

Public Sub SetRangeForDropdown()
On Error Resume Next

    Application.EnableEvents = False

    'Get new List of employees from Employee sheet
    Dim rng1 As Range
    With wsDB_employee
        Set rng1 = .Range("A2:B" & .Range("A10000").End(xlUp).Row)
    End With
    With wsStage
        .Cells.Clear
        rng1.Copy .Range(.Cells(1, 1), .Cells(rng1.Rows.Count, 2))
    End With

    'Set range for dropdown on employee sheet
    Dim rng2 As Range
    Set rng2 = wsStage.Range("A1:B" & wsStage.Range("A10000").End(xlUp).Row)

    'Update employee list named formula
    ActiveWorkbook.Names.Add Name:="nfEmployeeList", RefersTo:=rng2
    Dim str As String
    str = rng2.Parent.Name & "!" & rng2.Address 'Source path for list fill range
    wsMA.cmbEmployeeSelection.ListFillRange = str

    Application.EnableEvents = True

End Sub

显然EnableEvents 不适用于 ActiveX 控件。

感谢微软让生活变得更加复杂！

刚刚发现：“Application.EnableEvents=False/True ONLY 适用于工作表和工作簿事件，不适用于 ActiveX 控件事件”来自此处enter link description here

【问题讨论】：

标签： vba excel

【解决方案1】：

您可以禁用SetRangeForDropdown 中的事件，然后重新启用它们。

所以，在开头写下：

Application.EnableEvents = False

最后是以下内容：

Application.EnableEvents = true

【讨论】：

做到了！谢谢
很抱歉取消选中答案...但是尽管设置了Application.EnableEvents = False，但如果我从另一个程序调用它，_Change 事件会再次触发。所以不幸的是，其他事情仍在发生。
代码在.Cells.Clear行再次触发
你能不能在.Cells之前写。清除下面的>Debug.print Application.EnableEvents
如果你从另一个过程中调用它，你应该在这个过程中写Application.enableEvents = FAlse和True。

【解决方案2】：

让（几乎）确保始终恢复事件处理始终是一个好习惯，如下所示：

Public Sub SetRangeForDropdown()


'...your code

    On Error GoTo ExitSub
    Application.EnableEvents = False
    wsMA.cmbEmployeeSelection.ListFillRange = rng2

    'Update employee list named formula
    ActiveWorkbook.Names.Add name:="nfEmployeeList", RefersTo:=rng2

ExitSub:
    Application.EnableEvents = True

End Sub

此外，除非你真的需要，否则避免使用On Error Resume Next

【讨论】：

可悲的是，这似乎还没有解决。也感谢您的观看。
实施了您的建议并更换了错误处理程序
在不做任何广告的情况下，考虑安装 MZ-Tools 来编写自动错误处理程序。对你有很大帮助。
我有 MZ-Tools，实际上我确实经常使用它......虽然我发现错误处理程序代码通常没有那么有用......

【解决方案3】：

我已通过添加一个阻止_Change 事件触发的全局变量解决了这个问题。这是代码：

Private Sub cmbEmployeeSelection_Change()

If bNOTRUN = False Then 'Check if ActiveX event should fire or not

    modEmployeeDB.SaveEmployeeData 'Save currently selected employee data
    modEmployeeDB.DBSoll_To_WorkerInfo 'Get called employee data

End If

End Sub

这是修改后的模块...注意我添加的简单布尔变量：

Public Sub SetRangeForDropdown()

On Error GoTo SetRangeForDropdown_Error

    bNOTRUN = True 'Global Variable that when True prevents Active X from firing

    'Get new List of employees from Employee sheet
    Dim rng1 As Range
    With wsDB_employee
        Set rng1 = .Range("A2:B" & .Range("A10000").End(xlUp).Row)
    End With
    With wsStage

        .Cells.Clear
        rng1.Copy .Range(.Cells(1, 1), .Cells(rng1.Rows.Count, 2))

    End With

    'Set range for dropdown on employee sheet
    Dim rng2 As Range
    Set rng2 = wsStage.Range("A1:B" & wsStage.Range("A10000").End(xlUp).Row)

    'Update employee list named formula
    ActiveWorkbook.Names.Add Name:="nfEmployeeList", RefersTo:=rng2
    Dim str As String
    str = rng2.Parent.Name & "!" & rng2.Address 'Source path for list fill range
    wsMA.cmbEmployeeSelection.ListFillRange = str

    bNOTRUN = False

    On Error GoTo 0
    Exit Sub

SetRangeForDropdown_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure SetRangeForDropdown of Sub modEmployeeDB"
    bNOTRUN = False

End Sub

【讨论】：