Excel VBA - 检查工作表是否受到密码保护

Question

我们可以使用ProtectContents属性检查工作表是否受保护。但是，如何检查是否使用密码保护了它呢？

if ws.ProtectContents then
    ''do something
end if 

- D. O.

Answer 1

我不相信有一种通过属性直接实现这个的方法。但是，你可以尝试使用空密码取消保护工作表，如果失败就捕获错误：

Function isSheetProtectedWithPassword(ws As Worksheet) As Boolean
    If ws.ProtectContents Then
        On Error GoTo errorLabel
        ws.Unprotect ""
        ws.Protect
    End If
errorLabel:
    If Err.Number = 1004 Then isSheetProtectedWithPassword = True
End Function

你可以这样调用它：

isSheetProtectedWithPassword(Worksheets("Sheet1"))

它将返回True或False

- JNevill

---

谢谢JNevill。 - D. O.

我认为你需要在结尾加上一个“else isSheetProtectedWithPassword = false”...？ - aamailhot

嗨@user3617389。布尔值的默认值为FALSE，因此不必要。但是，如果您想明确说明，那么不仅需要使用else，而且还需要在End If之后添加isSheetProtectedWithPassword = false（只有在内容未受保护且未引发错误时才会到达该行）。 - JNevill

Answer 2

要检查密码保护，需要尝试取消保护工作表，然后再次保护它（如果它没有受到密码保护），但此时会失去用户所做的所有保护设置，如允许数据透视表、允许单元格格式化等。

因此，在保护工作表之前，必须首先读取工作表的设置，并在保护时重新应用这些设置。保护不仅包括protectcontents，还包括protectobject和protectscenarios。

如果是图表工作表，则需要使用不同的过程进行检查。我花了几个小时创建一个宏，可以为所有工作表（甚至图表工作表）执行所有这些操作。

 Sub Run_CheckSheetPasswordProtection()
    'execudes the Function CheckSheetPasswordProtection
    'to detect if a sheet (Worksheet or Chart Sheet) is protected, password protected or not protected
    'protection setting of that sheet will remain the same after checking (other, simpler, macros will not take car for this)
    
    Dim wb As Workbook
    Dim ws As Variant 'variant is needed to handle Worksheets AND Chart Sheets
    Dim sh As Variant
    
    Set wb = ThisWorkbook 'or use: Workbooks("Name of my Workbook")
    
    '***check one sheet*****
'    'adjust your worksheet you want to test here
'    Set ws = wb.Worksheets("sheet1")
'
'    MsgBox ws.Name & ":     " & CheckSheetPasswordProtection(ws)
    
    
    
    '****check all sheets of a workbook**********
    
    For Each sh In wb.Sheets
        'write ansers to the Immediate Window
        Debug.Print sh.Name & ":     " & CheckSheetPasswordProtection(sh)
    Next sh
End Sub


Function CheckSheetPasswordProtection(YourSheet As Variant) As String
    'check if worksheets are protected with a password
    'doesn't destroy the previous protection settings of that sheet
    Dim ws As Variant
    Dim wb As Workbook
    Dim ProtectionResult As String
    
    'Settings of the sheet
    Dim sDrawingObjects As Boolean
    Dim sContents As Boolean
    Dim sScenarios As Boolean
    Dim sUserInterfaceOnly As Boolean
    Dim sAllowFormattingCells As Boolean
    Dim sAllowFormattingColumns As Boolean
    Dim sAllowFormattingRows As Boolean
    Dim sAllowInsertingColumns As Boolean
    Dim sAllowInsertingRows As Boolean
    Dim sAllowInseringHyperlinks As Boolean
    Dim sAllowDeletingColumns As Boolean
    Dim sAllowDeletingRows As Boolean
    Dim sAllowSorting As Boolean
    Dim sAllowFiltering As Boolean
    Dim sAllowUsingPivotTables As Boolean
    Dim sEnableSelection As Integer ' 0   Anything can be selected, -4142   Nothing can be selected, 1   Only unlocked cells can be selected.
    Dim sEnableOutlining As Boolean
    
    Set ws = YourSheet
    
    
        '***********if it is a worksheet**************
        If TypeName(ws) = "Worksheet" Then
        
            'check protection settings of the sheet
            sDrawingObjects = ws.ProtectDrawingObjects
            sContents = ws.ProtectContents
            sScenarios = ws.ProtectScenarios
            sUserInterfaceOnly = ws.ProtectionMode
            sAllowFormattingCells = ws.Protection.AllowFormattingCells
            sAllowFormattingColumns = ws.Protection.AllowFormattingColumns
            sAllowFormattingRows = ws.Protection.AllowFormattingRows
            sAllowInsertingColumns = ws.Protection.AllowInsertingColumns
            sAllowInsertingRows = ws.Protection.AllowInsertingRows
            sAllowInseringHyperlinks = ws.Protection.AllowInsertingHyperlinks
            sAllowDeletingColumns = ws.Protection.AllowDeletingColumns
            sAllowDeletingRows = ws.Protection.AllowDeletingRows
            sAllowSorting = ws.Protection.AllowSorting
            sAllowFiltering = ws.Protection.AllowFiltering
            sAllowUsingPivotTables = ws.Protection.AllowUsingPivotTables
            sEnableSelection = ws.EnableSelection
            sEnableOutlining = ws.EnableOutlining
            
            If ws.ProtectContents Or ws.ProtectDrawingObjects Or ws.ProtectScenarios Then
                ProtectionResult = "Protected"
            
                On Error Resume Next
                ws.Unprotect Password:=""
                If Err.Number > 0 Then
                    ProtectionResult = "PASSWORD protected"
                Else 'if sheet was not protected with password, protect it again with its previous setting
                    ws.Protect _
                    Password:="", _
                    DrawingObjects:=sDrawingObjects, _
                    Contents:=sContents, _
                    Scenarios:=sScenarios, _
                    AllowFormattingCells:=sAllowFormattingCells, _
                    AllowFormattingColumns:=sAllowFormattingColumns, _
                    AllowFormattingRows:=sAllowFormattingRows, _
                    AllowInsertingColumns:=sAllowInsertingColumns, _
                    AllowInsertingRows:=sAllowInsertingRows, _
                    AllowInsertingHyperlinks:=sAllowInseringHyperlinks, _
                    AllowDeletingColumns:=sAllowDeletingColumns, _
                    AllowDeletingRows:=sAllowDeletingRows, _
                    AllowSorting:=sAllowSorting, _
                    AllowFiltering:=sAllowFiltering, _
                    AllowUsingPivotTables:=sAllowUsingPivotTables, _
                    UserInterfaceOnly:=sUserInterfaceOnly
                
                    ws.EnableSelection = sEnableSelection
                    ws.EnableOutlining = sEnableOutlining
                End If 'checking for password (error)
                On Error GoTo 0
            Else 'if worksheet is not protected
                ProtectionResult = "No Protection"
            End If 'if protected
            
        
        Else '*************if it is a chart*************** If TypeName(ws) = "Chart"
            'check protection settings of the sheet
            sDrawingObjects = ws.ProtectDrawingObjects
            sContents = ws.ProtectContents
            
            'if chart is protected
            If ws.ProtectContents Or ws.ProtectDrawingObjects Then
                ProtectionResult = "Protected"
            
                On Error Resume Next
                ws.Unprotect Password:=""
                If Err.Number > 0 Then
                    ProtectionResult = "PASSWORD protected"
                Else 'if sheet was not protected with password, protect it again with its previous setting
                    ws.Protect _
                    Password:="", _
                    DrawingObjects:=sDrawingObjects, _
                    Contents:=sContents
                End If 'checking for password (error)
                On Error GoTo 0
            Else 'if worksheet is not protected
                ProtectionResult = "No Protection"
            End If 'if protected
            
        
        End If 'Worksheet or Chart
        CheckSheetPasswordProtection = ProtectionResult

End Function

- WeAreOne