VBA动态生成多选框checkbox

luckberry

由于公司权限申请模版中需要多选，但为了让员工申请时填写的权限更加规范，而Excel本身的有效性是不支持多选的，因为想到通过点击这一列自动弹出窗体加载权限控件来选择。希望对有需要的朋友参考，欢迎指正。
已设置了自动关联创建控件，控件的宽度会随着控件的添加而调整。




关联的权限放在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




该贴已经同步到 luckberry的微博

fzkoko

学习了，谢谢

lzqlaj

能不能传个附件，方便测试。

xgy0214dxy

谢谢，学习了

xyetim

谢谢，学习了

常州海达装潢

非常感谢！值得学习！

鄂龙蒙

好作品！收藏！！！

hakdo

附件啊！这个正是紧急需要的啊

wormtiger

谢谢，学习了。

wormtiger

我来添加个附件，除了sheets3的选项是随便打的，所有的内容都按楼主的来。欢迎大家测试。