Question

我试图通过在关键点禁用事件来避免事件循环。但是，它并不总是有效。例如，这个代码用于组合框：

Private Sub TempComboS_Change()
Dim e
e = Application.EnableEvents
Application.EnableEvents = False
  ' 
Application.EnableEvents = e
End Sub

空白行是有用代码所在的位置;就目前而言，它显然没有做任何事情。但是，当我以这种方式运行它（使用空行）时，它会到达“End Sub”，然后它会返回到开头并再次运行。（这会使有用的代码运行两次）。

为什么会这样？

编辑：澄清那些一直在帮助我的人。

我有一个宏打开组合框的下拉列表，激活它，然后结束。它工作正常。当我从打开列表中选择一个项目时，将运行Change事件。这是更改事件的当前版本：

Private Sub TempComboS_Change()
End Sub

我在Private Sub行上设置了一个断点。它显示此Change事件运行，然后再次运行。我怀疑它一直这样做，现在我注意到了，因为我需要在这里添加代码。

我没有课程模块或用户表单。控件位于工作表上。

我将尝试“运行一次”建议，如果有效，我会告诉您。

我尝试了您建议的“运行一次”代码。它排序的作品，但我似乎有一个更大的问题。当我从数据验证的单元格中选择一个下拉列表时，TempComboS_Change事件会触发 - 但不仅我没有触摸这个组合框，该单元格不是组合框的LinkedCell。换句话说，它似乎是由未连接的动作触发到组合框！

要了解那个Call Stack的事情......

Answer 1

以下是一些有助于调查“事件顺序”问题的代码

在标准模块中

Public Enum eNewLine
    No
    Before
    After
    Both
End Enum

Public Function timeStamp(Optional d As Double = 0, Optional newLine As eNewLine = No, Optional Indent As Long = 0, _
                            Optional Caller As String, Optional Context As String, Optional message As String) As String
Dim errorMessage As String

    If Err.number <> 0 Then
        errorMessage = "ERROR: " & Err.number & ": " & Err.Description
        Err.Clear
    End If
    If d = 0 Then d = Time
    With Application.WorksheetFunction
        timeStamp = .Text(Hour(d), "00") & ":" & .Text(Minute(d), "00") & ":" & .Text(Second(d), "00") & ":" & .rept(Chr(9), Indent)
    End With
    If Len(Caller) <> 0 Then timeStamp = timeStamp & Chr(9) & Caller
    If Len(Context) <> 0 Then timeStamp = timeStamp & ": " & Chr(9) & Context
    If Len(message) <> 0 Then timeStamp = timeStamp & ": " & Chr(9) & message
    Select Case newLine
    Case Before
        timeStamp = Chr(10) & timeStamp
    Case After
        timeStamp = timeStamp & Chr(10)
    Case Both
        timeStamp = Chr(10) & timeStamp & Chr(10)
    Case Else
    End Select
    If Len(errorMessage) <> 0 Then
        timeStamp = timeStamp & Chr(9) & errorMessage
    End If

End Function

在每个模块的顶部

'Module level Trace Hearder
Const debugEvents as Boolean = True
Const cModuleName As String = "myModuleName"
Const cModuleIndent As Long = 1

您可以为每个模块分配模块级别缩进以组织层次结构，以便于理解。

在每个子或函数（或属性，如果您需要）......

sub mySubName()
Const cMyName As String = "mySubName"

If debugEvents Then Debug.Print timeStamp(NewLine:=Before,Indent:=cModuleIndent, Caller:=cModuleName, Context:=cMyName, Message:="Start")

'Do stuff

If debugEvents Then Debug.Print timeStamp(NewLine:=After,Indent:=cModuleIndent, Caller:=cModuleName, Context:=cMyName, Message:="End")
End Sub

...或者你可以使用Me.Name作为Context，如果它是一个表单或工作表等，你可以在Message中放入你喜欢的任何消息或变量值。

您也可以使用Timer（例如MicroTimer）并将结果放入Message部分。

以下是输出示例：

15:54:07:       Roll-Up Select:     Worksheet_Activate:      Start: 3.24591834214516E-03


15:54:07:           cDataViewSheet:     Class_Initialize:   Start

15:54:07:               cRevealTarget:  Class_Initialize:   START
15:54:07:               cRevealTarget:  Class_Initialize:   END

15:54:09:           cDataViewSheet:     startTimer:     : START
15:54:09:           cDataViewSheet:     startTimer:     init Timer
15:54:09:               cOnTime:    Class_Initialize
15:54:09:               cOnTime:    Let PulseTime:  Inheret PulseTime from host sheet
15:54:09:           cDataViewSheet:     startTimer:     : END

15:54:09:       Roll-Up Select:     Worksheet_Activate:      END:   1.38736216780671

Answer 2

Private Sub cmbOrder_Change()
    If cmbOrder = "" Then Exit Sub

    Dim arr As Variant, maxorder As Integer
    arr = Range("rngOrder")
    maxorder = WorksheetFunction.Max(arr)
    Dim errmsg As String, err As Boolean
    err = False
    errmsg = "This value must be a whole number between 1 and " & maxorder + 1
    Dim v As Variant
    v = cmbOrder.Value
    If IsNumeric(v) = False Or (IsNumeric(v) = True And (v > maxorder + 1) Or v < 1) 
    Then
        MsgBox errmsg
        cmbOrder = ""
        err = False
    Else
        txtOrder.Value = cmbOrder.Value
    End If

End Sub

晚了一点，但是在类似的情况下，代码重复的问题仍然可以在这里看到。删除第一行代码，所有错误消息都会抛出两次。这是因为该行清除了被视为更改的ComboBox并拾取了另一个错误，因为null输入是一个错误！可能会帮助遇到类似问题的人。

Answer 3

只要组合框发生变化，Combobox_Change（）就会触发。例如

Option Explicit

Private Sub UserForm_Initialize()
    ComboBox1.AddItem "Bah Blah"
End Sub

Private Sub CommandButton1_Click()
    '~~> If something is selected in the combo then
    '~~> this line will cause ComboBox1_Change to fire
    ComboBox1.Clear
End Sub

Private Sub ComboBox1_Change()
    MsgBox "A"
End Sub

因此，如果您加载用户表单并选择一个项目ComboBox1_Change将会触发。然后使用commanbutton清除ComboBox1_Change将再次触发的组合。

还有一种情况会再次发生变化。当change来自ComboBox1_Change事件本身的组合框时。这是一个例子。我believe这就是你的情况。

情景1

Private Sub UserForm_Initialize()
    ComboBox1.AddItem "Bah Blah"
End Sub

Private Sub ComboBox1_Change()
    MsgBox "A"
    ComboBox1.Clear
End Sub

场景2

Private Sub UserForm_Initialize()
    ComboBox1.AddItem "Bah Blah"
    ComboBox1.AddItem "Bah Blah Blah"
End Sub

Private Sub ComboBox1_Change()
    MsgBox "A"
    ComboBox1.ListIndex = 1
End Sub

在第一个场景中，您可以使用

Private Sub UserForm_Initialize()
    ComboBox1.AddItem "Bah Blah"
End Sub

Private Sub ComboBox1_Change()
    If ComboBox1 <> "" Then
        MsgBox "A"
    End If
End Sub

在第二个场景中，你可以使用类似的东西

Dim boolRunOnce As Boolean

Private Sub UserForm_Initialize()
    ComboBox1.AddItem "Bah Blah"
    ComboBox1.AddItem "Bah Blah Blah"
End Sub

Private Sub ComboBox1_Change()
    If boolRunOnce = False Then
        MsgBox "A"
        boolRunOnce = True
        ComboBox1.ListIndex = 1
    Else
        boolRunOnce = False
    End If
End Sub

Excel VBA：为什么事件会触发两次？

3 个答案: