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

Question

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

Sheet 1中包括动态数据范围G，H，I，J让说值10,20,30,40

我想在Sheet 2中，细胞E2自动创建的复选框一旦有数据在Sheet1范围G，H，I，J

'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

所以这里是我的版本。

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