如何包含此代码以自动填充动态数据中的复选框

Question

我有一个包含5列的工作表，我想在另一个工作表中自动创建ActiveX复选框，并将其标题作为动态数据值。

Sheet1 包含动态数据范围G，H，I，J让我们说值10,20,30,40

我想要 Sheet2 ，一旦Sheet1范围G，H，I，J中有数据，就会自动创建一个单元格E2复选框

'Private Sub UserForm_Initialize()
Dim NewChkBx As MSForms.CheckBox
    Dim rngSource As Range
    Dim rngSource2 As Range
    Dim rngSource3 As Range
    Dim rngSource4 As Range
    Dim rngSource5 As Range
    Dim Quantity_definition_1 As Range
    Dim Quantity_definition_2 As Range
    Dim Quantity_definition_3 As Range
    Dim Quantity_definition_4 As Range
    Dim Quantity_definition_5 As Range
    Dim TopPos As Integer
    Dim MaxWidth As Long

    With Worksheets("AppSyncData")

        Set rngSource = .Range("F2", .Cells(.Rows.Count, "F").End(xlUp))
        Set rngSource2 = .Range("G2", .Cells(.Rows.Count, "G").End(xlUp))
        Set rngSource3 = .Range("H2", .Cells(.Rows.Count, "H").End(xlUp))
        Set rngSource4 = .Range("I2", .Cells(.Rows.Count, "I").End(xlUp))
        Set rngSource5 = .Range("J2", .Cells(.Rows.Count, "J").End(xlUp))

    End With

    TopPos = 15

    MaxWidth = 0

    For Each Quantity_definition_1 In rngSource
        If Quantity_definition_1.Value <> "" Then
            Set NewChkBx = Me.Controls.Add("Forms.CheckBox.1")
            With NewChkBx
                .Caption = Quantity_definition_1.Value
                .Left = 5
                .Top = TopPos
                .AutoSize = True
                If .Width > MaxWidth Then MaxWidth = .Width
            End With
            TopPos = TopPos + 15
        End If
    Next Quantity_definition_1

    TopPos = 15

    For Each Quantity_definition_2 In rngSource2
        If Quantity_definition_2.Value <> "" Then
            Set NewChkBx = Me.Controls.Add("Forms.CheckBox.1")
            With NewChkBx
                .Caption = Quantity_definition_2.Value
                .Left = 50
                .Top = TopPos
                .AutoSize = True
                If .Width > MaxWidth Then MaxWidth = .Width
            End With
            TopPos = TopPos + 15
        End If

     Next Quantity_definition_2

        TopPos = 15

    For Each Quantity_definition_3 In rngSource3
        If Quantity_definition_3.Value <> "" Then
            Set NewChkBx = Me.Controls.Add("Forms.CheckBox.1")
            With NewChkBx
                .Caption = Quantity_definition_3.Value
                .Left = 95
                .Top = TopPos
                .AutoSize = True
                If .Width > MaxWidth Then MaxWidth = 500
            End With
            TopPos = TopPos + 15
        End If
    Next Quantity_definition_3

    TopPos = 15

     For Each Quantity_definition_4 In rngSource4
        If Quantity_definition_4.Value <> "" Then
            Set NewChkBx = Me.Controls.Add("Forms.CheckBox.1")
            With NewChkBx
                .Caption = Quantity_definition_4.Value
                .Left = 135
                .Top = TopPos
                .AutoSize = True
                If .Width > MaxWidth Then MaxWidth = 500
            End With
            TopPos = TopPos + 15
        End If
    Next Quantity_definition_4

    TopPos = 15

     For Each Quantity_definition_5 In rngSource5
        If Quantity_definition_5.Value <> "" Then
            Set NewChkBx = Me.Controls.Add("Forms.CheckBox.1")
            With NewChkBx
                .Caption = Quantity_definition_5.Value
                .Left = 180
                .Top = TopPos
                .AutoSize = True
                If .Width > MaxWidth Then MaxWidth = 500

                End With

            TopPos = TopPos + 15
        End If
    Next Quantity_definition_5


    Me.Width = MaxWidth + 40

    Me.Height = TopPos + 40


End Sub

Answer 1

So here is my version.

Private Sub GenerateCheckboxes()
    Dim ws As Excel.Worksheet
    Set ws = ThisWorkbook.Worksheets("AppSyncData")

    Dim ws2 As Excel.Worksheet
    Set ws2 = ThisWorkbook.Worksheets("Checkboxes")

    Dim vCheckBoxLefts As Variant
    vCheckBoxLefts = Array(5, 50, 95, 135, 180)

    Dim lLeftLoop As Long: lLeftLoop = 0

    Const TopPos As Long = 15
    Dim lTopOffset As Long
    Dim lMaxBottom As Long

    Dim lMaxRight As Long
    lMaxRight = 0


    Dim lColumnLoop As Long
    For lColumnLoop = 6 To 10

        lTopOffset = 0

        Dim rngSource As Excel.Range
        Set rngSource = ws.Range(ws.Cells(2, lColumnLoop), ws.Cells(ws.Rows.Count, lColumnLoop).End(xlUp))

        Dim vSource As Variant
        vSource = rngSource.Value

        Dim vQuantityDefinition As Variant
        For Each vQuantityDefinition In vSource
            If Len(vQuantityDefinition) > 0 Then

                Dim chkNew As Excel.CheckBox
                Set chkNew = ws2.CheckBoxes.Add(362.25, 92.25, 166.5, 48)
                chkNew.Caption = vQuantityDefinition
                chkNew.Left = vCheckBoxLefts(lLeftLoop)
                chkNew.Top = TopPos + lTopOffset
                If chkNew.Left + chkNew.Width > lMaxRight Then lMaxRight = chkNew.Left + chkNew.Width
                If chkNew.Top + chkNew.Height > lMaxBottom Then lMaxBottom = chkNew.Top + chkNew.Height

            lTopOffset = lTopOffset + 15

            End If
        Next vQuantityDefinition

        lLeftLoop = lLeftLoop + 1
    Next lColumnLoop


End Sub