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

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

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

如果要添加或删除.ListFillRange项目，如何防止调用_Change事件

更新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 

Appeently EnableEvents不适用于ActiveX控件 。

谢谢微软让生活变得更复杂一点！

刚发现这个：“Application.EnableEvents = False / True只适用于图纸和工作簿事件，而不是ActiveX控件事件”从这里input链接描述在这里

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事件触发的全局variables来解决这个问题。 这是代码：

 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 

这是修改后的模块…请注意我添加的简单的布尔variables：

 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