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

Question

We can check if a sheet is protected using ProtectContents property. But how check if it is protected with a password?

if ws.ProtectContents then
    ''do something
end if 

Answer 1

I don't believe there is a direct way of doing this by way of a property. Alternatively, though, you could attempt to unprotect the worksheet with a blank password and catch the error should it fail:

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

You can call this like:

isSheetProtectedWithPassword(Worksheets("Sheet1"))

And it will return True or False

Answer 2

If the sheet is not password protected, then it will be unprotected and after that protected again, but at that point it looses all the protection settings the user had made. Like Allow PivotTables , Allow Formatting Cells and so on. So one has to read the settings of the sheet first and when protecting it, applying the settings again. And if it is a Chart Sheet, it also needs to be taken care for. I spend som hours to create a macro which can do this for ALL Sheets (Worksheets and Chart Sheets) in the Workbook

Sub CheckPasswordProtection()
    '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 String
    Dim sEnableOutlining As String
    
    'Set wb = ActiveWorkbook
    'Set ws = wb.ActiveSheet
    Set wb = ActiveWorkbook
    
    
    For Each ws In wb.Sheets
    
        '***********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 sheet*************** 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
        MsgBox ws.Name & "    " & ProtectionResult
    Next ws
End Sub

Answer 3

If you need to check only one sheet or sheets in a loop, then above macro as function might be better:

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 ws As Variant 'variant is needed to handle Worksheets AND Chart Sheets
    
    'adjust your worksheet you want to test here
    Set ws = ActiveWorkbook.Worksheets("sheet1")
    
    MsgBox ws.Name & ":     " & CheckSheetPasswordProtection(ws)

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 String
    Dim sEnableOutlining As String
    
    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