Блог

У меня есть рабочая книга с несколькими листами. Я создаю список в пользовательской форме с этими листами в алфавитном порядке, нажимаю на строку и нажимаю печать.

Я хотел бы установить флажок и нажать поиск, и появятся только отфильтрованные листы.

Форма пользователя

Вкладки рабочего листа

 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
  

Ваша начальная загрузка формы вызывается 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 "* " amp; cb.Name amp; "*" then
                rv = False
                Exit For
            Else
                rv = True
            End If
        End If
        SheetOK = rv
    Next cb
    
End Function