如何在 Excel VBA 中的用戶窗體中添加 select 所有復選框選項

Question

所以我有這個代碼

Dim LastRow     As Long

Private Sub Remove_Files_Button_Click()


On Error GoTo Error:
Dim i As Long
For i = 1 To LastRow
    If Me.Controls("CheckBox_" & i) Then
        Range("G" & i).Value = Range("A" & i).Value
    End If
    If Me.Controls("CheckBox_" & i) Then
        Range("H" & i).Value = Range("B" & i).Value
    End If
    If Me.Controls("CheckBox_" & i) Then
        Range("I" & i).Value = Range("C" & i).Value
    End If
Next i
    Range("A:F").Select
    Selection.Delete Shift:=xlToLeft
    Range("A:B").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo
Error:
    Unload Me
End Sub


Sub UserForm_Initialize()

Dim i           As Long
Dim chkBox      As MSForms.CheckBox

On Error GoTo Error:
LastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To LastRow
    Set chkBox = Me.Controls.Add("Forms.CheckBox.1", "CheckBox_" & i)
    chkBox.Height = 30
    chkBox.Caption = Worksheets("Sheet1").Cells(i, 1).Value
    chkBox.Left = ((i - 1) Mod 4) * 100 + 5
    chkBox.Top = 5 + Fix((i - 1) / 4) * 30
Next i
Error:
End Sub

以 VBA 形式。 當我運行它時，我會生成此彈出窗口，在此處輸入圖像描述

我想做的，甚至無法弄清楚如何 go 是有第二個按鈕，如果點擊它會自動 select 所有復選框。 任何幫助，將不勝感激。 謝謝

Answer 1

遍歷控件並檢查控件的名稱。 如果like "checkbox*" then Value = True

Private Sub CommandButton1_Click()
    Dim ctl As Control
    For Each ctl In Me.Controls
        If ctl.Name Like "CheckBox*" Then
            ctl.Value = True
        End If
    Next ctl
End Sub

如果您需要將值更改回來，您可以制作另一個按鈕，只需將ctl.Value = True更改為ctl.Value = False ：

Private Sub CommandButton2_Click()
    Dim ctl As Control
    For Each ctl In Me.Controls
        If ctl.Name Like "CheckBox*" Then
            ctl.Value = False
        End If
    Next ctl
End Sub

或者添加另一個 if 語句來反轉值，但如果他們檢查某些內容，它將取消選中並且它們不會全部相等。

Private Sub CommandButton1_Click()
    Dim ctl As Control
    For Each ctl In Me.Controls
        If ctl.Name Like "CheckBox*" Then
            If ctl.Value = False Then
                ctl.Value = True
            Else
                ctl.Value = False
            End If
        End If
    Next ctl
End Sub