问题

我在Excel中有一个用户表单，在其中问题在一个Listbox控件中进行了索引。单击Listbox中的项目会调用Change事件，根据所选的项目填充其他控件的值。

用户可以更改文本框中的值。在更改它们后，会为该问题设置一个"已保存"标志为False。然后，用户可以将问题保存到内存中，或导航离开该问题。

如果用户在不保存的情况下导航（通过单击Listbox中的不同项目），我想向他们显示警告，提供以下选项：要么放弃未保存的更改，要么保留当前选择，并还原刚刚单击的Listbox选择。

如果选择"放弃更改"，那么一切正常。但是当我尝试还原Listbox选择时，它会遇到问题。我使用一个"EventsOn"布尔值来处理何时应该继续执行Change过程，以避免它调用自身。这似乎在代码中的正确点起作用。 但是在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()
    ' 省略了大量代码。基本上打开记录集并加载值
    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
    '
    ' 选择第一个问题为默认。请注意，Listbox ListIndex从0开始，而问题从1开始
    SelectedListIndex = 0
    CurrentQuestion = 1
    EventsOn = True
    lbox_QuestionList.ListIndex = SelectedListIndex
End Sub

Private Sub lbox_QuestionList_Change()
    ' 确保此事件在以编程方式更改时不会不断触发
    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
            ' 放弃更改 = 是
            ' 标记为已保存
            QuestionSaved(CurrentQuestion) = True
            ' 然后继续正常更改
            ' (如果用户回到这个问题，它将以原始形式重新加载到内存中)
            ' 这部分正常工作
        Else
            ' 放弃更改 = 否
            EventsOn = False ' 所以这个子过程不会再次被调用
            ' 还原ListBox选择。通过重新调用当前问题编号并应用于ListIndex来实现
            SelectedListIndex = CurrentQuestion - 1 ' 请记住索引将减1，因为索引从0开始
            lbox_QuestionList.ListIndex = SelectedListIndex
            EventsOn = True
            Exit Sub ' 这应该是结束。但不知何故，它并没有...
        End If
    End If
    ' 根据新选择的ListIndex继续加载新问题
    SelectedListIndex = lbox_QuestionList.ListIndex ' 认识当前选择
    ' ListIndex从零开始，所以我们需要加1
    CurrentQuestion = SelectedListIndex + 1
    ShowQuestion CurrentQuestion
End Sub

Private Sub ShowQuestion(QuestionNumber As Long)
    ' 为简洁起见，省略了详细信息。基本上从类的字典中加载详细信息，并填充到文本框中
End Sub

Private Sub cb_Save_Click()
    ' 省略了代码。获取当前文本框的值并将其保存到字典中的类中
    ' 将当前问题标记为已保存：
    QuestionSaved(CurrentQuestion) = True
End Sub

' 事件处理程序
Private Sub tb_Question_Change()
    DoChange
End Sub

' 几个其他表单控件有类似的事件：都调用下面的"DoChange"
Private Sub DoChange()
    If Not EventsOn Then Exit Sub
    QuestionSaved(CurrentQuestion) = False ' 如果对表单值进行任何更改，将当前问题标记为未保存
End Sub

我自然而然地搜索了这个问题，但目前还没有答案可以帮助我：

• stackoverflow.com/questions/5682012/listbox-events-firing-strangely - 与C#相关，而不是VBA
• stackoverflow.com/questions/11671916/listbox-selected-item-changed-event-fired-two-times - 与C#相关，而不是VBA
• stackoverflow.com/questions/36623581/vba-listbox-event-fires-twice - 建议使用Listbox的SetFocus方法可能会解决问题。但我已经尝试过了，问题依然存在。

我的代码逻辑似乎是正确的。谜底是为什么Change事件会再次被调用，即使在Exit Sub之后。

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

答案1

得分: 2

在查看了一段时间后，似乎从列表框的更改事件中设置其自己的列表索引（实际上是递归调用它）会引发一些奇怪的后端问题。幸运的是，通过将这部分移到自己的函数中进行迁移，可以轻松解决这个问题。经过一些实验，最好的方法是创建一个函数来清除并重新填充列表框，因此请在您的UserForm代码中创建这个函数：

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 ' 填充列表框项
        QuestionSaved(X) = True ' 对于每个问题，标记初始状态为已保存
        ' 如果不是X = rst.RecordCount Then rst.MoveNext
    Next X
    
    Me.lbox_QuestionList.ListIndex = arg_lSelected
    
End Function

现在调整您的初始化事件如下所示（请注意，您需要在此处定义NumberofQuestions，然后在最后调用新函数以填充列表框并选择第一个条目）：

Private Sub UserForm_Initialize()
    ' 在这里剥离了大量的代码。基本上是打开记录集并加载值
    
    NumberofQuestions = 3 ' 这是NumberofQuestions的定义位置
    ReDim QuestionSaved(1 To NumberofQuestions)
    ReDim aAnswers(1 To NumberofQuestions)
    
    '
    ' 默认情况下选择第一个问题。请注意，列表框的ListIndex从0开始，而问题从1开始
    SelectedListIndex = 0
    CurrentQuestion = 1
    EventsOn = True
    PopulateListbox SelectedListIndex ' 调用新函数并设置第一个选择
    
End Sub

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

Private Sub lbox_QuestionList_Change()
    
    ' 确保此事件在以编程方式更改时不会不断触发
    If Not EventsOn Then Exit Sub
    '
    If Not QuestionSaved(CurrentQuestion) Or aAnswers(CurrentQuestion) <> Me.tb_Question.Text Then   ' 我添加了第二个条件用于测试目的，可能在您的完整代码中不必要
        If MsgBox(Prompt:="放弃对当前问题的更改吗？", Title:="当前问题未保存", Buttons:=vbYesNo + vbDefaultButton2) = vbYes Then
            ' 放弃更改 = 是
            ' 标记为已保存
            QuestionSaved(CurrentQuestion) = True
            ' 然后正常进行更改
            ' （如果用户返回到此问题，它将以其原始形式从内存中重新加载）
            ' 这个方法可以正常工作
        Else
            ' 放弃更改 = 否
            EventsOn = False ' 因此不会再次调用此子程序
            ' 恢复ListBox选择。通过重新调用当前问题编号并将其应用于ListIndex来执行此操作
            SelectedListIndex = CurrentQuestion - 1 ' 请记住索引将减去1，因为索引从0开始
            PopulateListbox SelectedListIndex ' 在此处调用您的新函数
            
            EventsOn = True
            Exit Sub ' 这应该是它的结尾。但不知何故它不是...
        End If
    End If
    ' 继续根据新选择的ListIndex加载新问题
    SelectedListIndex = lbox_QuestionList.ListIndex ' 识别当前选择
    ' ListIndex从零开始，所以我们需要加1
    CurrentQuestion = SelectedListIndex + 1
    ShowQuestion CurrentQuestion
End Sub

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

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

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

答案2

得分: 2

以下是您提供的代码的翻译部分：

*(谴责OP让这个问题困扰我的脑子！)*

在我的测试中，我使用了以下UserForm：

[![输入图像描述][1]][1]

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

```vb
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 "列表框被点击，项目 " & (ListItemSelected() + 1) & " 被选中"
    If eventsInProgress > 0 Then
        Debug.Print "   ... 事件正在进行中，退出"
        eventsInProgress = eventsInProgress - 1
        Exit Sub
    End If
    
    If Not qSaved(selectedDuringTextboxChange) Then
        Dim answer As VbMsgBoxResult
        answer = MsgBox("放弃更改吗？", vbYesNo + vbDefaultButton2)
        If answer = vbYes Then
            Debug.Print "是的，放弃更改"
            qSaved(selectedDuringTextboxChange) = True
        Else
            Debug.Print "不，保留更改"
            '--- 返回到之前选择的列表项
            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 "更改了问题 " & 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 "问题 " & 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 "列表框项目(" & i & ") = " & .Selected(i)
        Next i
    End With
    Debug.Print "eventsInProgress = " & eventsInProgress
End Sub

<details>
<summary>英文:</summary>
*(curses to OP for getting this problem in my brain!)*
In my testing, I used the following UserForm:
[![enter image description here][1]][1]
The code below uses the `ListBox1_AfterUpdate` event, and I believe it may work for you.
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 &quot;listbox clicked, item &quot; &amp; (ListItemSelected() + 1) &amp; &quot; selected&quot;
If eventsInProgress &gt; 0 Then
Debug.Print &quot;   ... event in progress, exiting&quot;
eventsInProgress = eventsInProgress - 1
Exit Sub
End If
If Not qSaved(selectedDuringTextboxChange) Then
Dim answer As VbMsgBoxResult
answer = MsgBox(&quot;Abandon changes?&quot;, vbYesNo + vbDefaultButton2)
If answer = vbYes Then
Debug.Print &quot;yes, abandon the changes&quot;
qSaved(selectedDuringTextboxChange) = True
Else
Debug.Print &quot;nope, keep the changes&quot;
&#39;--- 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 &quot;changed text for question &quot; &amp; 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 &quot;Question &quot; &amp; 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 &quot;listbox item(&quot; &amp; i &amp; &quot;) = &quot; &amp; .Selected(i)
Next i
End With
Debug.Print &quot;eventsInProgress = &quot; &amp; eventsInProgress
End Sub
[1]: https://i.stack.imgur.com/pXyh2.png
</details>
# 答案3
**得分**: 0
Private Sub ListBox_Click() 函数运行两次的问题。
当我在列表框属性中清除了 ControlSource 后，问题就解决了。我不得不添加一行代码，以明确将列表框中的值写入工作表中的单元格。起初，单元格不会显示数据，所以我将范围名称设置为另一个单元格，那就没问题了。然后，我将新单元格拖放到原始位置。
我不明白问题从何而来，但修复方法有效。
<details>
<summary>英文:</summary>
I had a problem with a **Private Sub ListBox_Click()** running twice.
When I cleared the *ControlSource* in the list box properties it fixed the problem. I had to add a line of code to specifically write the value from the *listbox* to the cell in the worksheet. At first the cell would not display the data so I set the range name to another cell and that was OK. So, I then dragged and dropped the new cell into the original location. 
I don&#39;t understand where the problem originated, but the fix worked. 
</details>
# 答案4
**得分**: 0
I had a similar unexpected issue, so maybe someone will find this result helpful.
Within a multi-selection-enabled Listbox_Change event, I checked the value of the currently-selected item to see whether it had been checked or unchecked.
``` 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 语句并将结果放入布尔变量中时，问题消失了：

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

之后，ListBox 一直按预期行为。

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

    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