VBA: ListBox Change 事件触发两次

Question

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

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

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

如果选择"Abandon changes"，则效果很好。但是，当我尝试恢复列表框选择时，它遇到了麻烦。我使用 "EventsOn" 布尔值来处理 Change 过程何时应该继续，以避免它调用自己。 这似乎在代码中的正确位置起作用。但是在恢复 EventsOn 和 Exit Sub 之后，Change 事件似乎又被称为.

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

由于涉及到其他窗体控件的细节，所以下面的代码被去掉了很多； loading/saving 来自数据库的数据；并处理类和字典。但是我保留了表单控件的相关逻辑：

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

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

Listbox events firing strangely - 与 C# 相关而不是 VBA
listbox selected item changed event fired two times - 与 C# 相关而不是 VBA
vba listbox event fires twice - 建议列表框的 SetFocus 方法可以解决问题。但是我试过了，问题依旧

我的代码逻辑似乎很合理。谜团是为什么要第二次调用 Change 事件，即使在 Exit Sub.

之后也是如此

Answer 1

经过一段时间的调查，似乎让列表框在其自身的更改事件中设置自己的列表索引（有效地递归调用它）会导致一些奇怪的后端问题。幸运的是，通过将该位迁移到它自己的函数中就很容易处理。经过一些试验，最好的方法是创建一个清除和重新填充列表框的函数，因此在您的用户窗体代码中创建这个函数：

Private Function PopulateListbox(Optional ByVal arg_lSelected As Long = -1)

    Me.lbox_QuestionList.Clear

    Dim X As Long '
    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

    Me.lbox_QuestionList.ListIndex = arg_lSelected

End Function

现在将您的 Initialize 事件调整为如下所示（请注意，您需要在此处定义 NumberofQuestions，然后在末尾调用新函数来填充列表框和 select 第一个条目):

Private Sub UserForm_Initialize()
    ' Stripped out lots of code here. Basically opens a recordset and loads values

    NumberofQuestions = 3  'This is where NumberofQuestions gets defined
    ReDim QuestionSaved(1 To NumberofQuestions)
    ReDim aAnswers(1 To NumberofQuestions)

    '
    ' 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
    PopulateListbox SelectedListIndex  'Call the new function and set the 1st selection

End Sub

最后，将您的 listbox_change 事件更新为如下所示（基本上只是将列表框条目的设置外包给新函数）：

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) Or aAnswers(CurrentQuestion) <> Me.tb_Question.Text Then   'I added the second condition for testing purposes, may not be necessary in your full code
        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
            PopulateListbox SelectedListIndex 'Call your new function here

            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

Answer 2

（诅咒 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

Answer 3

我遇到了 Private Sub ListBox_Click() 运行两次问题。

当我清除列表框属性中的 ControlSource 时，问题就解决了。我不得不添加一行代码专门将 列表框 中的值写入工作表中的单元格。起初单元格不会显示数据，所以我将范围名称设置为另一个单元格，这样就可以了。因此，然后我将新单元格拖放到原始位置。

我不明白问题出在哪里，但修复有效。

Answer 4

我遇到了类似的意外问题，所以也许有人会发现此结果有帮助。在 multi-selection-enabled Listbox_Change 事件中，我检查了 currently-selected 项的值以查看它是否已被选中。

    Private Sub lstBox_Change()
        With lstBox
            If .Selected(.ListIndex) Then
                ' Call Method A.
            Else
                ' Call Method B.
            End If
        End With
    End Sub

选中列表后，它会正确检测到选择并调用 A-- 但是，当单步执行代码并到达 Change 事件的 End Sub 时，复选框会自动取消选中，并且 Change 事件会再次开火。请注意，我没有在 ListBox 本身中设置任何值；我只是检查当前项目是否已选中或未选中。但是，不知何故，这触发了它取消选择自己。（此外，这似乎只发生在第一次调用 Change 事件时。此后它表现正常。）

我尝试了其他一些修复程序，但 BeforeUpdate 和 AfterUpdate 似乎根本没有触发。当我将选择测试移到 If 语句之外并将结果放入布尔值时，问题就消失了：

    Private Sub lstBox_Change()
        With lstBox
            BooleanResult = (.Selected(.ListIndex) = True)
            If BooleanResult Then
                ' Call Method A.
            Else
                ' Call Method B.
            End If
        End With
    End Sub

此后，ListBox 的行为始终符合预期。

VBA: ListBox Change 事件触发两次

VBA: ListBox Change event firing twice

excel

vba

listbox

userform