首页 > 解决方案 > Using check boxes to filter list box of worksheets

问题描述

I have a workbook with multiple worksheets. I create a list box on a user form with these worksheets in alphabetical order, click on the line and hit print.

I would like to check a box and hit search and have only the filtered worksheets appear.

User Form
enter image description here

Worksheet tabs
enter image description here

Dim i As Long

Private Sub CommandButton1_Click()
    ListBox1.Clear
    SE = False
    TE = False
    SS = False
    TS = False
    AK = False
    EK = False
    
    End Sub
    
    Private Sub FilterButton1_Click()
    
    If SE = True Then
    For i = 1 To ActiveWorkbook.Sheets.Count
        ListBox1.AddItem ActiveWorkbook.Sheets(i).Name
        Next i
    End If
    If TE = True Then
    For i = 1 To ActiveWorkbook.Sheets.Count
        ListBox1.AddItem ActiveWorkbook.Sheets(i).Name = "*TE*"
    Next i
    End If
    If SS = True Then
    For i = 1 To ActiveWorkbook.Sheets.Count
        ListBox1.AddItem ActiveWorkbook.Sheets(i).Name = "*SS*"
    Next i
    End If
    If TS = True Then
    For i = 1 To ActiveWorkbook.Sheets.Count
        ListBox1.AddItem ActiveWorkbook.Sheets(i).Name = "*TS*"
    Next i
    End If
    If AK = True Then
    For i = 1 To ActiveWorkbook.Sheets.Count
        ListBox1.AddItem ActiveWorkbook.Sheets(i).Name = "*AK*"
    Next i
    End If
    If EK = True Then
    For i = 1 To ActiveWorkbook.Sheets.Count
        ListBox1.AddItem ActiveWorkbook.Sheets(i).Name = "*EK*"
    Next i
    End If
    
End Sub

标签: excelvba

解决方案


您的初始表单加载调用LoadSheetList不带参数,因此将加载所有工作表。

您的“过滤器”按钮调用LoadSheetList True只会根据复选框状态添加工作表。

Sub LoadSheetList(Optional filtered As Boolean = False)
    Dim ws As Worksheet, nm
    
    ListBox1.Clear 'first remove all items
    'loop all sheets
    For Each ws In ActiveWorkbook.Worksheets
        nm = ws.Name
        If Not filtered Or (filtered And SheetOK(nm)) Then
            ListBox1.AddItem nm 'add if included or not filtering
        End If
    Next ws
End Sub

'review checkbox status to see is a sheet with the provided name should be added
'EDIT: updated to "and" checkboxes, not "or"
Function SheetOK(sheetName) As Boolean
    Dim cb, rv as Boolean

    rv = False 'default result
    For Each cb In Array(SE, TE, SS, TS, AK, EK)
        If cb.Value = True then
            if not sheetName Like "* " & cb.Name & "*" then
                rv = False
                Exit For
            Else
                rv = True
            End If
        End If
        SheetOK = rv
    Next cb
    
End Function

推荐阅读