VBA隐藏名称中带有“工作表”的工作表

Question

我将下面的代码放在一起，使用复选框隐藏命名工作表。该工作簿还包含具有通用名称的工作表，如 Sheet1、Sheet2 等，我希望能够从同一个复选框中隐藏名称中包含“Sheet”一词的所有工作表。

这可能吗？

谢谢

Private Sub CheckBox1_Click()

Application.ScreenUpdating = False

If CheckBox1 = False Then
If ThisWorkbook.Sheets("Summary").Range("B10") <> "" Then Sheets(ActiveSheet.Range("B10").Value).Visible = False
Else:
If ThisWorkbook.Sheets("Summary").Range("B10") <> "" Then Sheets(ActiveSheet.Range("B10").Value).Visible = True
End If

Application.ScreenUpdating = False

End Sub

Answer 1

如果你真的想隐藏工作表，请使用下一个代码。它隐藏了名称以“Sheet”开头的所有工作表：

Private Sub CheckBox1_Click()
  Dim sh As Worksheet
  
  For Each sh In Worksheets
    If left(sh.name, 5) = "Sheet" Then
        sh.Visible = xlSheetVeryHidden
    End If
  Next
End Sub

Answer 2

隐藏带图案的工作表

提醒

• 工作簿中的所有工作表中至少有一张必须可见。
• 此解决方案未考虑第三个“可见性”参数xlSheetHidden。
• 您可以使用一组工作表名称一次性隐藏多个工作表（快），但您必须循环访问该数组才能取消隐藏每个工作表（慢）。

守则

Option Explicit

Private Sub CheckBox1_Click()
    
    Const WorksheetPattern As String = "ShEeT*"
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim wsArr As Variant
    
    Application.ScreenUpdating = False
    If CheckBox1 Then ' Hide
        wsArr = WorksheetNamesToArray(wb, WorksheetPattern)
        wb.Worksheets(wsArr).Visible = xlSheetHidden ' also 0 or False
    Else ' UnHide
        wsArr = WorksheetNamesToArray(wb, WorksheetPattern, xlSheetHidden)
        Dim n As Long
        For n = 1 To UBound(wsArr)
            wb.Worksheets(wsArr(n)).Visible = xlSheetVisible ' also -1 or True
        Next n
    End If
    Application.ScreenUpdating = True

End Sub

Function WorksheetNamesToArray( _
    ByVal wb As Workbook, _
    ByVal WorksheetPattern As String, _
    Optional ByVal isVisible As XlSheetVisibility = xlSheetVisible) _
As Variant
    If Not wb Is Nothing Then
        Dim wsCount As Long: wsCount = wb.Worksheets.Count
        Dim wsArr() As String: ReDim wsArr(1 To wsCount)
        Dim ws As Worksheet
        Dim n As Long
        For Each ws In wb.Worksheets
            If UCase(ws.Name) Like UCase(WorksheetPattern) Then
                If ws.Visible = isVisible Then
                    n = n + 1
                    wsArr(n) = ws.Name
                End If
            End If
        Next ws
        ReDim Preserve wsArr(1 To n)
        WorksheetNamesToArray = wsArr
    End If
End Function