通过点击按钮对tree型控件进行多选_VBA分享--组合框控件的组合使用

去年因为工作需要用VBA做了一个下单表，跟大家分享下里面组合框控件的组合使用，交互性和操作性都比较友好，效果见下面GIF动图。

通过筛选区域和店铺等级让店铺明细动态变化，用了3个ListBox组合框控件实现。

区域LB3代码：

Private Sub ListBox3_Click() '区域选择
 With Sheet10
        rq = .Range("j2:j5").Value'区域
    End With
With ListBox3 '调整位置到单元格处
        .Top = Sheet1.Cells(15, 1).Top 'listbox的顶端位置
        .Left = Sheet1.Cells(15, 1).Left  'listbox的左端位置
        .Width = 58 '宽度
        .Height = 70 '高度
        .Visible = True '可见
        '.ColumnHeads = True '显示标题行
        .ColumnCount = 1 '三列
        .ColumnWidths = "40" '设置第一列宽度50第二列宽度130……
        .List = rq '数据来源
        .MultiSelect = fmMultiSelectMulti '允许通过鼠标点击的方式进行多选
        .ListStyle = fmListStyleOption '选项按钮设置为方形
    End With
End Sub

店铺等级LB2代码：

Private Sub ListBox2_Click() '店铺等级选择
    
 With Sheet10
        rq = .Range("h2:h5").Value'店铺等级
    End With
With ListBox2 '调整位置到单元格处
        .Top = Sheet1.Cells(15, 2).Top 'listbox的顶端位置
        .Left = Sheet1.Cells(15, 2).Left  'listbox的左端位置
        .Width = 58 '宽度
        .Height = 70 '高度
        .Visible = True '可见
        '.ColumnHeads = True '显示标题行
        .ColumnCount = 1 '三列
        .ColumnWidths = "40" '设置第一列宽度50第二列宽度130……
        .List = rq '数据来源
        .MultiSelect = fmMultiSelectMulti '允许通过鼠标点击的方式进行多选
        .ListStyle = fmListStyleOption '选项按钮设置为方形
    End With
End Sub

店铺明细LB1代码：

Private Sub ListBox1_Click() '选择区域和等级后自动生成店铺明细
               Dim prr, orr, irr, urr, yrr
               Application.DisplayAlerts = False
       With Sheet8
                 R = .Range("f2:h" & .Cells(Rows.Count, "h").End(xlUp).Row).Value
                 prr = R
       End With
            With ListBox3'当筛选区域后
                   For i = 0 To .ListCount - 1
                   If .Selected(i) = True Then
                       kk = kk + 1
                   End If
                   Next
                  If kk = 0 Then Sheet1.ListBox1.Clear: Exit Sub
                ReDim orr(1 To kk, 1 To 1)
                  kk = 1
                  For i = 0 To .ListCount - 1
                  If .Selected(i) = True Then
                      orr(kk, 1) = .List(i, 0) '勾选后的区域
                      kk = kk + 1
                       End If
                  Next
            End With
            
            With ListBox2'当筛选店铺等级后
                   For ii = 0 To .ListCount - 1
                   If .Selected(ii) = True Then
                       kkk = kkk + 1
                   End If
                   Next
                   If kkk = 0 Then Sheet1.ListBox1.Clear: Exit Sub
              ReDim irr(1 To kkk, 1 To 1)
                  kkk = 1
                  For ii = 0 To .ListCount - 1
                  If .Selected(ii) = True Then
                      irr(kkk, 1) = .List(ii, 0) '勾选后的等级
                      kkk = kkk + 1
                       End If
                  Next
            End With
            
            For T = 1 To UBound(prr)
                For t1 = 1 To UBound(orr)
                If prr(T, 1) = orr(t1, 1) Then
                           kkkk = kkkk + 1
                End If
                  Next
            Next
            
            If kkkk = 0 Then Sheet1.ListBox1.Clear: Exit Sub
          ReDim urr(1 To kkkk, 1 To 3)
           kkkk = 1
           
           For t2 = 1 To UBound(prr)
                For t3 = 1 To UBound(orr)
                If prr(t2, 1) = orr(t3, 1) Then
                urr(kkkk, 1) = prr(t2, 1)
                urr(kkkk, 2) = prr(t2, 2)
                urr(kkkk, 3) = prr(t2, 3)        '按区域筛选后的店铺
                     kkkk = kkkk + 1
                End If
                  Next
            Next
          
            For t4 = 1 To UBound(urr)
                For t5 = 1 To UBound(irr)
                If urr(t4, 2) = irr(t5, 1) Then
                           kkkkk = kkkkk + 1
                End If
                  Next
            Next
            
            If kkkkk = 0 Then Sheet1.ListBox1.Clear: Exit Sub
          ReDim yrr(1 To kkkkk, 1 To 3)
          kkkkk = 1
            For t6 = 1 To UBound(urr)
                For t7 = 1 To UBound(irr)
                If urr(t6, 2) = irr(t7, 1) Then
                yrr(kkkkk, 1) = urr(t6, 1)
                yrr(kkkkk, 2) = urr(t6, 2)
                yrr(kkkkk, 3) = urr(t6, 3)        '按等级筛选后的店铺
                     kkkkk = kkkkk + 1
                End If
                  Next
            Next
     With ListBox1
        '调整位置到单元格处
        .Top = Sheet1.Cells(20, 1).Top 'listbox的顶端位置
        .Left = Sheet1.Cells(20, 1).Left  'listbox的左端位置
        .Width = 280 '宽度
        .Height = 800 '高度
        .Visible = True '可见
        '.ColumnHeads = True '显示标题行
        .ColumnCount = 3 '三列
        .ColumnWidths = "40;60;180" '设置第一列宽度50第二列宽度130……
        .List = yrr '数据来源
        .MultiSelect = fmMultiSelectMulti '允许通过鼠标点击的方式进行多选
        .ListStyle = fmListStyleOption '选项按钮设置为方形
    End With
    Application.DisplayAlerts = True
End Sub

以上3个ListBox代码还需要以下代码进行关联，当区域和店铺等级发生变化LB1发生变化，需要用到change事件，当发生LB3、LB2发生变化LB1就运行。

Private Sub ListBox3_Change() '等级更新店铺更新
    ListBox1_Click
End Sub

Private Sub ListBox2_Change() '等级更新店铺更新
   ListBox1_Click
End Sub

当以上代码写完后，重新打开表格会发现区域和店铺等级是空的，如下图，因为要运行了ListBox代码后才能进行筛选。

这里就要加入一个当表格启用时就运行LB3、LB2、LB1代码。此段代码在ThisWorkbook里填写。

Private Sub Workbook_Open() '在打开工作簿时发生
    Sheet1.setacive   '其中setacive就是我们下一个代码要设置的
End Sub

在sheet1里面填写以下代码

Sub setacive()
    ListBox3_Click
    ListBox2_Click
End Sub

这两个段代码组合使用就能实现当表格打开时就运行区域和店铺等级！