Блог

В моей электронной таблице есть выпадающая форма 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" amp; .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" amp; 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 amp; "!" amp; rng2.Address 'Source path for list fill range
    wsMA.cmbEmployeeSelection.ListFillRange = str

    Application.EnableEvents = True

End Sub
  

По-видимому, EnableEvents не работает для элементов управления ActiveX.

Спасибо Microsoft за то, что вы немного усложнили жизнь!

Только что нашел это: «Приложение.EnableEvents=False / True ПРИМЕНЯЕТСЯ ТОЛЬКО к событиям листа и книги, а не к событиям элемента управления ActiveX» отсюда введите описание ссылки здесь

Вы можете отключить события в SetRangeForDropdown , а затем включить их обратно.

Итак, в начале напишите следующее:

 Application.EnableEvents = False
  

И следующее в конце:

 Application.EnableEvents = true
  

всегда полезно убедиться (почти), что обработка событий всегда возвращается, например:

 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 , если вам это действительно не нужно

Я решил проблему, добавив глобальную переменную, которая предотвращает запуск _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" amp; .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" amp; 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 amp; "!" amp; rng2.Address 'Source path for list fill range
    wsMA.cmbEmployeeSelection.ListFillRange = str

    bNOTRUN = False

    On Error GoTo 0
    Exit Sub

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

End Sub