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

Question

我们可以使用 ProtectContents 属性检查 sheet 是否受到保护。但是如何检查它是否受密码保护？

if ws.ProtectContents then
    ''do something
end if

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"))

它会 return True 或 False

Answer 2

要检查密码保护，需要尝试取消对 sheet 的保护，然后再对其进行保护（如果它没有密码保护），但此时它 失去了所有用户所做的保护设置。像 Allow PivotTables、Allow Formatting Cells 等等。所以必须先读取 sheet 的设置，然后在保护它时再次应用设置。保护不仅意味着 protectcontents，还意味着 protectobject 和 protectscenarios。而如果是 Chart Sheet，也需要不同的程序来检查。我花了几个小时来创建一个宏，它可以为所有 Sheet 执行所有这些操作（甚至对于 Chart Sheets）。

 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

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

Excel VBA - Check if a worksheet is protected WITH A PASSWORD

excel

vba

worksheet