VBA 动态生成多选框

关联的权限放在sheet3的A列中

实现代码:

//新建一个模块，建立一个公共变量
Public rangeAddr As String

//sheet1 添加代码
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Column = 11 Then
        rangeAddr = Target.Address'将单元格地址保存到公共变量中
        UserForm1.Show
    End If
End Sub


//新建一个窗体，添加代码如下：

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
   On Error Resume Next
     For I = 0 To UserForm1.Controls.Count - 1
        If UserForm1.Controls(I) = True Then
            Tval = Tval & "+" & UserForm1.Controls(I).Caption
        End If
    Next
    Sheet1.Activate
    'MsgBox rangeAddr
    Sheet1.Range(rangeAddr).Value = Right(Tval, Len(Tval) - 1)'将结果关联到选中的单元格
End Sub

Private Sub TextBox1_Change()

End Sub

Private Sub UserForm_Initialize()
'先计算有多少个控件，每10个换列
If Sheet3.Range("A2").End(xlDown).Row / 10 > Round(Sheet3.Range("A2").End(xlDown).Row / 10, 0) Then
    counts = Round(Sheet3.Range("A2").End(xlDown).Row / 10, 0) + 1
Else
     counts = Sheet3.Range("A2").End(xlDown).Row / 10
End If
'设置窗体高度和宽度
UserForm1.Width = 150 * counts'每增加1列宽度加150。（这里并没有判断是否会超过屏幕的宽度，如果数据量太多可以调整每列显示的个数
UserForm1.Height = 250

For X = 1 To counts

    Y = 10 * X '每列显示10个控件

    If X = 1 Then '开始第1列显示
        Start = 2
        Ends = 11
    Else '换列显示
        Start = Ends + 1
        Ends = Y + 1
    End If

    If Ends > Sheet3.Range("A2").End(xlDown).Row Then '防止溢出
        Ends = Sheet3.Range("A2").End(xlDown).Row
    End If

   'Debug.Print "STRAT:" & Start & "  Ends : " & Ends
    For I = Start To Ends '循环生成控件
       Set ChkBox = UserForm1.Controls.Add("Forms.CheckBox.1", "Chk" & Str(I))
       If I > 11 Then
           tops = 2 + 20 * (I - Y + 8) '换列后的控件高度坐标
       Else
          tops = 2 + 20 * (I - 2)
       End If
       ChkBox.Top = tops
       ChkBox.Height = 25'控件的高度
       ChkBox.Width = 200'控件的宽度
       ChkBox.Left = 20 + 150 * (X - 1) '220 换列后的横坐标
      ' Debug.Print "TOP:" & tops & "  LEFT: " & 20 + 150 * (X - 1) '220
       ChkBox.Caption = Sheet3.Cells(I, 1)'控件显示的标题
       Set ChkBox = Nothing
    Next
      'Debug.Print "X:" & X
Next

End Sub