Question

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

我有各种解决方法，所有这些都是更改列表源的一些版本，但没有成功。之所以没有这样做是因为清除或更改.ListFillRange实际上会再次触发_Change事件。

如果我想添加或删除_Change

中的项目，如何阻止调用.ListFillRange事件？

UPDATE 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仅适用于工作表和工作簿事件，而不适用于ActiveX控件事件”enter link description here

Answer 1

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

因此，请在开头写下以下内容：

Application.EnableEvents = False

以下结尾：

Application.EnableEvents = true

Answer 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

Answer 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

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

3 个答案: