VBA：ListBox Change 事件触发两次

Question

我在 Excel 中有一个用户窗体，其中问题在 Listbox 控件中编入索引。单击列表框中的项目会调用 Change 事件，该事件根据已选择的项目填充其他控件的值。

用户可以更改文本框中的值。更改它们后，该问题的“已保存”标志将设置为 False。然后用户可以将问题保存到内存中；或离开问题。

如果用户在没有保存的情况下导航离开（通过单击列表框中的不同项目），我想向他们显示警告 - 提供放弃未保存更改的选项；或保留当前选择，并恢复他们刚刚单击的列表框选择。

如果选择“放弃更改”，则工作正常。但是，当我尝试恢复列表框选择时遇到了麻烦。我使用“EventsOn”布尔值来处理何时应该继续更改过程，以避免它调用自身。这似乎有效，在代码中的正确位置。但是在 EventsOn 恢复之后，并且在Exit Sub 之后，似乎再次调用了 Change 事件。

我不知道为什么该事件再次触发。这会导致用户第二次看到该选项。

下面的很多代码因为涉及到其他表单控件的细节，所以被删掉了；从数据库加载/保存数据；和处理类和字典。但是我保留了表单控件的相关逻辑：

Option Explicit
Dim NumberOfQuestions As Long
Dim EventsOn As Boolean
Dim SelectedListIndex As Long, CurrentQuestion As Long, QuestionSaved As Variant

Private Sub UserForm_Initialize()
    ' Stripped out lots of code here. Basically opens a recordset and loads values
    ReDim QuestionSaved(1 To NumberOfQuestions) As Boolean
    '
    For X = 1 To NumberOfQuestions
        lbox_QuestionList.AddItem "Question " & X ' Populate the listbox with items
        QuestionSaved(X) = True ' Flag the initial state as saved, for each question
        If Not X = rst.RecordCount Then rst.MoveNext
    Next X
    '
    ' Select the first question by default. Note that the Listbox ListIndex starts at 0, whereas the questions start at 1
    SelectedListIndex = 0
    CurrentQuestion = 1
    EventsOn = True
    lbox_QuestionList.ListIndex = SelectedListIndex
End Sub

Private Sub lbox_QuestionList_Change()
    ' Ensure this event does NOT keep firing in a loop, when changed programmatically
    If Not EventsOn Then Exit Sub
    '
    If Not QuestionSaved(CurrentQuestion) Then
        If MsgBox(Prompt:="Abandon changes to current question?", Title:="Current question not saved", Buttons:=vbYesNo + vbDefaultButton2) = vbYes Then
            ' Abandon changes = Yes
            ' Mark as saved
            QuestionSaved(CurrentQuestion) = True
            ' Then proceed to change as normal
            ' (If the user comes back to this question, it will be re-loaded from memory in its original form)
            ' This works okay
        Else
            ' Abandon changes = No
            EventsOn = False ' So this sub is not called again
            ' REVERT the ListBox selection. Do this by recalling the current question number, and applying it to the ListIndex
            SelectedListIndex = CurrentQuestion - 1 ' Remember that the index will be minus 1, due to indexing starting at 0
            lbox_QuestionList.ListIndex = SelectedListIndex
            EventsOn = True
            Exit Sub ' This should be the end of it. But somehow, it's not...
        End If
    End If
    ' Proceed with loading a new question according to the new selected ListIndex
    SelectedListIndex = lbox_QuestionList.ListIndex ' Recognise the current selection
    ' ListIndex starts at zero, so we need to add 1
    CurrentQuestion = SelectedListIndex + 1
    ShowQuestion CurrentQuestion
End Sub

Private Sub ShowQuestion(QuestionNumber As Long)
    ' Stripped out code for brevity. Basically loads details from a dictionary of classes, and populates into textboxes
End Sub

Private Sub cb_Save_Click()
    ' Stipped out code. Takes values of current text boxes and saves them into a class in a dictionary
    ' Mark the current question as saved:
    QuestionSaved(CurrentQuestion) = True
End Sub

''''''''''' Event handlers ''''''''''''''
Private Sub tb_Question_Change()
    DoChange
End Sub
' Several other form controls have similar events: all calling "DoChange" as below

Private Sub DoChange()
    If Not EventsOn Then Exit Sub
    QuestionSaved(CurrentQuestion) = False ' Flag the current question as NOT saved, if any changes are made to form values
End Sub

当然，我已经搜索了这个问题 - 但到目前为止还没有帮助我的答案：

• 列表框事件奇怪地触发- 与 C# 相关，而不是 VBA
• 列表框选定项目更改事件触发了两次- 与 C# 相关，而不是 VBA
• vba 列表框事件触发两次- 表明列表框的 SetFocus 方法可以解决该问题。但是我已经尝试过这个，问题仍然存在

我的代码逻辑似乎很合理。神秘的是为什么 Change 事件被第二次调用，即使在Exit Sub 之后。

Answer 1

（诅咒OP让我的大脑出现这个问题！）

在我的测试中，我使用了以下用户表单：

下面的代码使用了该ListBox1_AfterUpdate事件，我相信它可能适合您。

Option Explicit

Private Const TOTAL_QUESTIONS As Long = 3
Private qSaved As Variant
Private selectedDuringTextboxChange As Long
Private eventsInProgress As Long

Private Sub ListBox1_AfterUpdate()
    Debug.Print "listbox clicked, item " & (ListItemSelected() + 1) & " selected"
    If eventsInProgress > 0 Then
        Debug.Print "   ... event in progress, exiting"
        eventsInProgress = eventsInProgress - 1
        Exit Sub
    End If

    If Not qSaved(selectedDuringTextboxChange) Then
        Dim answer As VbMsgBoxResult
        answer = MsgBox("Abandon changes?", vbYesNo + vbDefaultButton2)
        If answer = vbYes Then
            Debug.Print "yes, abandon the changes"
            qSaved(selectedDuringTextboxChange) = True
        Else
            Debug.Print "nope, keep the changes"
            '--- return to the previously selected list item
            eventsInProgress = eventsInProgress + 1
            UnselectAll
            ListBox1.Selected(selectedDuringTextboxChange - 1) = True
            ListBox1.ListIndex = selectedDuringTextboxChange - 1
        End If
    End If
End Sub

Private Sub QuitButton_Click()
    Me.Hide
End Sub

Private Sub SaveButton_Click()
    qSaved(ListBox1.ListIndex + 1) = True
End Sub

Private Sub TextBox1_Change()
    selectedDuringTextboxChange = ListBox1.ListIndex + 1
    qSaved(selectedDuringTextboxChange) = False
    Debug.Print "changed text for question " & selectedDuringTextboxChange
End Sub

Private Sub UserForm_Initialize()
    ReDim qSaved(1 To TOTAL_QUESTIONS)

    selectedDuringTextboxChange = 1
    With ListBox1
        Dim i As Long
        For i = 1 To TOTAL_QUESTIONS
            .AddItem "Question " & i
            qSaved(i) = True
        Next i
        .Selected(0) = True
    End With
    eventsInProgress = False
End Sub

Private Sub UnselectAll()
    eventsInProgress = eventsInProgress + 1
    With ListBox1
        Dim i As Long
        For i = 0 To .ListCount - 1
            .Selected(i) = False
        Next i
    End With
    eventsInProgress = eventsInProgress - 1
End Sub

Private Function ListItemSelected() As Long
    ListItemSelected = -1
    With ListBox1
        Dim i As Long
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                ListItemSelected = i
            End If
        Next i
    End With
End Function

Private Sub WhichListItem_Click()
    With ListBox1
        Dim i As Long
        For i = 0 To .ListCount - 1
            Debug.Print "listbox item(" & i & ") = " & .Selected(i)
        Next i
    End With
    Debug.Print "eventsInProgress = " & eventsInProgress
End Sub