VBA实现工作表保护与允许编辑区域解锁失败求助

问题根源 #

• 先解锁区域再保护工作表：工作表保护会默认重置所有单元格为锁定状态，导致之前解锁的区域被重新锁定。
• 先保护工作表再修改区域锁定属性：工作表处于保护状态时，无法修改单元格的Locked属性，触发运行时错误。

修正方案 #

正确流程应为：先解除工作表保护（若已保护）→ 解锁目标区域 → 重新保护工作表并保留区域可编辑权限。以下提供两种实现方式：

方案1：使用UserInterfaceOnly参数（无需重复解除保护）

该参数设为True时，VBA可在工作表保护状态下修改单元格属性，同时用户界面仅锁定未授权区域。

Sub ProtectSheets()
    Dim ws As Worksheet
    Dim sheetPassword As String
    
    ' 读取保护密码（注意：用XFD列存密码易误操作，建议改用隐藏工作表或加密命名范围）
    sheetPassword = Worksheets("Data Validation").Range("XFD1048576").Value
    
    For Each ws In ThisWorkbook.Worksheets
        ' 筛选指定标签颜色的工作表
        If ws.Tab.Color = RGB(33, 28, 91) Then
            ' 先解除现有保护
            If ws.ProtectContents Then
                ws.Unprotect sheetPassword
            End If
            
            ' 解锁目标命名区域
            ws.Range("RestInputs").Locked = False
            ws.Range("CAInputs").Locked = False
            
            ' 重新保护工作表，启用UserInterfaceOnly
            ws.Protect Password:=sheetPassword, UserInterfaceOnly:=True
        End If
    Next ws
End Sub

方案2：添加带独立密码的允许编辑区域（适合分权限场景）

若需给不同区域设置单独编辑密码，可通过AllowEditRanges对象添加授权区域：

Sub ProtectSheetsWithRangePasswords()
    Dim ws As Worksheet
    Dim sheetPassword As String
    Dim range1Password As String
    Dim range2Password As String
    
    ' 读取各类密码
    sheetPassword = Worksheets("Data Validation").Range("XFD1048576").Value
    range1Password = Worksheets("Data Validation").Range("XFD1048575").Value
    range2Password = Worksheets("Data Validation").Range("XFD1048574").Value
    
    For Each ws In ThisWorkbook.Worksheets
        If ws.Tab.Color = RGB(33, 28, 91) Then
            ' 解除现有保护
            If ws.ProtectContents Then
                ws.Unprotect sheetPassword
            End If
            
            ' 清除已有的允许编辑区域（避免重复添加）
            On Error Resume Next
            ws.Protection.AllowEditRanges.Delete
            On Error GoTo 0
            
            ' 添加带密码的允许编辑区域
            ws.Protection.AllowEditRanges.Add _
                Title:="RestInputs", _
                Range:=ws.Range("RestInputs"), _
                Password:=range1Password
            ws.Protection.AllowEditRanges.Add _
                Title:="CAInputs", _
                Range:=ws.Range("CAInputs"), _
                Password:=range2Password
            
            ' 保护工作表
            ws.Protect Password:=sheetPassword
        End If
    Next ws
End Sub

注意事项 #

• UserInterfaceOnly参数仅在当前会话有效，关闭并重新打开工作簿后会失效，需在工作簿打开事件中重新执行保护代码以持久生效。
• 避免用XFD列这类极端位置存储敏感信息，建议改用隐藏工作表或加密命名范围。

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