Excel VBA Userform CheckBox复选标记不出现答案

【问题标题】：Excel VBA Userform CheckBox check mark does not appearExcel VBA Userform CheckBox复选标记不出现
【发布时间】：2020-12-10 21:14:37
【问题描述】：

我在 Excel 中创建了一个用户窗体。 UserForm 添加了一个 ListBox 和一个 CheckBox。

我编写了 VBA 代码，用 UserForm_Data 工作表的第一列中的数据填充 ListBox。我正在尝试将全选复选框添加到用户窗体。当我单击 CheckBox 一次时，不会出现复选标记，但会执行 Checkbox1_Change 事件的 If Me.CheckBox.Value = True 部分并选择 ListBox 中的所有项目。复选标记仅在我第二次单击 CheckBox 时出现。附上 Excel VBA 代码和用户窗体的图像。

Option Explicit

Private Sub ListBox1_Change()

Dim i As Long

If CheckBox1.Value = True Then
    For i = 0 To Me.ListBox1.ListCount - 1
    
        If Me.ListBox1.Selected(i) = False Then
            Me.CheckBox1.Value = False
        End If
    Next i
End If

End Sub

Private Sub CheckBox1_Change()

    Dim i As Long
 
    If Me.CheckBox1.Value = True Then
        With Me.ListBox1
            For i = 0 To .ListCount - 1
                .Selected(i) = True
            Next i
        End With
    Else
        i = 0
    End If
 
End Sub

Private Sub UserForm_Initialize()

    Dim rng1 As Range
    Dim ws1 As Worksheet
    Dim i, lastRow As Long
    Dim list1 As Object
    Dim string1 As String
    Dim array1 As Variant
    
    Set list1 = CreateObject("System.Collections.ArrayList")
    Set ws1 = ThisWorkbook.Worksheets("UserForm_data")
    
    lastRow = ws1.UsedRange.Rows.Count
    
    Me.ListBox1.Clear
    
    For i = 2 To lastRow
        string1 = CStr(ws1.Cells(i, 1).Value)
        If Not list1.Contains(string1) Then
            list1.Add string1
        End If
    Next i
    
    array1 = list1.ToArray
       
    Me.Caption = "UserForm1"
    Me.ListBox1.list = array1
    Me.ListBox1.MultiSelect = 1
    Me.CheckBox1.Value = False

End Sub

【问题讨论】：

2 个更改事件导致了问题。 CheckBox1_Change 正在更改 ListBox1，它会触发 ListBox1_Change 事件，它正在更改 CheckBox1，它会触发 CheckBox1_Change 事件。你明白了。最终结果就是您所经历的。
我在 3 个子过程的开头和结尾添加了 Application.EnableEvents = False 和 Application.EnableEvents = True 以防止事件相互触发。但我仍然遇到同样的错误。
这是正确的想法，但它只影响应用程序事件而不影响控制事件。因此，一种解决方案是使用全局标志来实现您的想法。
我通过修改我的 ListBox1_Change 事件解决了这个问题，因此如果未选择任何项目并退出 Sub，它将 CheckBox1 设置为 False。但是，在 Sub 的末尾，我将 CheckBox1 设置为 True。感谢您的帮助。

标签： vba

【解决方案1】：

您可以采取两个步骤来解决这个问题：

在 CheckBox1_Change 事件的末尾添加一个 DoEvents 可能会强制重绘。
如果这不起作用，请在 DoEvents 上方添加以下行并再次测试...这会鼓励屏幕更新...

Application.WindowState = Application.WindowState

【讨论】：

我从上面的代码中省略了 ListBox1_Change 事件。如果用户取消选择项目，我创建了此事件以取消选中 CheckBox。但是，添加此事件会导致复选框无法正常工作。我现在已将事件附加到上面的代码中。我尝试将 DoEvents 和 Application.WindowState = Application.Window 状态的不同组合添加到 2 个宏中，但仍然遇到相同的错误。

【解决方案2】：

一种方法是使用全局标志来打开和关闭控制事件处理程序。更新后的事件如下所示：

Option Explicit

Private Sub ListBox1_Change()
    Dim i As Long
    
    If Not AllowListBoxEvents Then Exit Sub
    
    AllowCheckBoxEvents = False
    
    If CheckBox1.Value = True Then
        For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) = False Then CheckBox1.Value = False
        Next i
    End If

    AllowCheckBoxEvents = True
End Sub

Private Sub CheckBox1_Change()
    Dim i As Long
 
    If Not AllowCheckBoxEvents Then Exit Sub
 
    AllowListBoxEvents = False
 
    If CheckBox1.Value = True Then
        For i = 0 To ListBox1.ListCount - 1
            ListBox1.Selected(i) = True
        Next i
    End If

    AllowListBoxEvents = True
End Sub

确保在 Initialize 事件中将“允许”变量设置为 True。

【讨论】：