VBA如何编写引用当前工作簿所有工作表的数组？

问题背景 #

我使用Spreadsheet Guru的代码批量保护/取消保护工作表，文件由我更新后供团队使用，保护时设置了部分单元格可编辑、部分不可编辑。但每年工作表名称都会更换，不想手动在数组（如"Sheet1","Sheet2","Sheet3"）中罗列表名修改宏，希望实现数组自动包含当前运行宏的工作簿的所有工作表，且只对该工作簿生效，重点修改原代码中SheetArray的定义部分。

原代码如下：

Sub SheetProtection_Toggle()
'PURPOSE: Add/Remove password protection to a list of tab names
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim SheetArray As Variant
Dim sht As Worksheet
Dim Password As String
Dim NotFoundList As String
Dim WrongPasswordList As String
Dim ProtectionStateDetermined As Boolean
Dim UnprotectSheet As Boolean
Dim x As Long

'INPUTS
  SheetArray = Array("Sheet1", "Sheet2", "Sheet4")
  Password = "Password123"

'Loop through each sheet name
  For x = LBound(SheetArray) To UBound(SheetArray)
    'Store Sheet Object to Variable
      On Error Resume Next
      Set sht = Nothing
      Set sht = ActiveWorkbook.Sheets(SheetArray(x))
      On Error GoTo 0
    
    'Was Sheet found in Activeworkbook?
      If Not sht Is Nothing Then
        'Determine if we need to protect or unprotect these sheets (based off of first instance)
          If ProtectionStateDetermined = False And (sht.ProtectContents Or sht.ProtectDrawingObjects Or sht.ProtectScenarios) Then UnprotectSheet = True
          ProtectionStateDetermined = True
    
        'Lock/Unlock worksheet
          If UnprotectSheet = True Then
            On Error Resume Next
            sht.Unprotect Password
            If sht.ProtectContents = True Then WrongPasswordList = WrongPasswordList & "• " & SheetArray(x) & Chr(10)
            On Error GoTo 0
          Else
            sht.Protect Password
          End If
        
      Else
        'Store a list of sheets not found in the ActiveWorkbook
          NotFoundList = NotFoundList & "• " & SheetArray(x) & Chr(10)
      End If
  Next x

'Report what was done to the worksheets
  If UnprotectSheet = True Then
    MsgBox "Sheets Unprotected!"
  Else
    MsgBox "Sheets Protected!"
  End If

'Report any sheet names that were not found (if applicable)
  If NotFoundList <> "" Then
    MsgBox "The following Worksheets were not found in your Excel file:" & Chr(10) & Chr(10) & Trim(NotFoundList)
  End If

'Report any sheets that could not be unprotected (if applicable)
  If WrongPasswordList <> "" Then
    MsgBox "The following Worksheets were unable to be unprotected:" & Chr(10) & Chr(10) & Trim(WrongPasswordList)
  End If

End Sub

解决方案 #

核心修改是移除手动指定的工作表名称数组，直接遍历宏所在工作簿的所有工作表对象，用ThisWorkbook代替ActiveWorkbook确保只作用于当前宏所在的文件，避免误操作其他打开的工作簿。同时简化循环逻辑，省去查找工作表的步骤，提升效率。

修改后的完整代码：

Sub SheetProtection_Toggle_AllSheets()
'PURPOSE: Add/Remove password protection to ALL sheets in the workbook containing this macro
'ADAPTED FROM: Spreadsheet Guru code

Dim sht As Worksheet
Dim Password As String
Dim WrongPasswordList As String
Dim ProtectionStateDetermined As Boolean
Dim UnprotectSheet As Boolean

'INPUTS
  Password = "Password123" '替换为你的密码

'Loop through EVERY sheet in the workbook containing this macro
  For Each sht In ThisWorkbook.Sheets
    'Determine if we need to protect or unprotect (based on first sheet's state)
      If Not ProtectionStateDetermined Then
        UnprotectSheet = (sht.ProtectContents Or sht.ProtectDrawingObjects Or sht.ProtectScenarios)
        ProtectionStateDetermined = True
      End If
    
    'Lock/Unlock worksheet
      If UnprotectSheet Then
        On Error Resume Next
        sht.Unprotect Password
        'Check if unprotect failed (wrong password)
        If sht.ProtectContents Then
          WrongPasswordList = WrongPasswordList & "• " & sht.Name & Chr(10)
        End If
        On Error GoTo 0
      Else
        '保护时保留单元格编辑权限设置（你之前配置的可编辑单元格无需改动）
        sht.Protect Password, UserInterfaceOnly:=True 'UserInterfaceOnly=True可让宏仍能修改受保护的表
      End If
  Next sht

'Report action completed
  MsgBox IIf(UnprotectSheet, "所有工作表已取消保护！", "所有工作表已保护！")

'Report any sheets that failed to unprotect
  If WrongPasswordList <> "" Then
    MsgBox "以下工作表无法取消保护（密码错误）：" & Chr(10) & Chr(10) & Trim(WrongPasswordList)
  End If

End Sub

关键修改说明 #

1. 替换工作表数组为直接遍历：用For Each sht In ThisWorkbook.Sheets代替原有的数组循环，自动包含当前工作簿所有工作表，无需手动更新表名
2. 锁定目标工作簿：使用ThisWorkbook而非ActiveWorkbook，确保只对宏所在的文件生效，避免误操作其他打开的工作簿
3. 简化逻辑：省去查找工作表的步骤，直接操作工作表对象，同时移除了"找不到工作表"的提示（因为遍历的都是存在的表）
4. 优化保护设置：添加UserInterfaceOnly:=True参数，这样保护后宏仍能编辑工作表，不影响你后续的更新操作，同时保留你之前设置的单元格编辑权限

内容的提问来源于stack exchange，提问作者Michael Trimble