如何使用密码取消保护工作簿、运行代码、重新保护工作簿？

Question

我想运行一个宏

1. 使用密码“test”解除对整个工作簿的保护
2. 在中间运行代码
3. 用密码重新保护。
4. 显示“已完成”消息，指示宏运行正常。

如果密码不正确，宏应显示“错误密码不正确”。

我没有收到输入正确密码的错误，但中间的代码没有运行并且工作簿没有重新保护。 但是我收到一条消息说“已完成”。 如果密码正确，我应该只收到“已完成”消息，宏的 rest 运行并且工作簿被密码重新保护。

Dim S As Object
Dim pWord1 As String
pWord1 = InputBox("Enter password")
If pWord1 = "" Then Exit Sub
For Each wSheet In Worksheets
    On Error GoTo errorTrap1
    wSheet.Unprotect Password:=pWord1
Next wSheet
MsgBox "Completed."
Exit Sub
errorTrap1:
    MsgBox "Error-Password Incorrect"
    Exit Sub

下面的代码在宏的末尾，用密码“test”重新保护。

    Dim pWord1 As String
    pWord1 = "test"
    If pWord1 = "" Then Exit Sub
    For Each ws In Worksheets
        ws.Protect Password:=pWord1
    Next
    Exit Sub

Answer 1

这是我的方法（有待改进，但应该让你开始）

一些建议：

• 缩进你的代码
• 尝试在代码开头设置变量初始化，如内部密码
• 将变量命名为可读的名称
• 使用函数和子过程分块执行代码，更容易调试

代码

Public Sub CheckProtect()   

    Dim userPassword As String
    Dim internalPassword As String
    
    ' Set internal password to force protection
    internalPassword = "test"
    
    ' Get password from user
    userPassword = InputBox("Enter password")
    
    ' If password is empty, exit procedure
    If userPassword = "" Then Exit Sub ' I'd alert the user at least....
    
    ' Check each sheet in current workbook
    Dim targetSheet As Worksheet
    For Each targetSheet In ThisWorkbook.Worksheets
        ' Validate if sheet if sheet is protected and password is valid
        Dim passwordIsValid As Boolean
        passwordIsValid = isWorksheetUnprotected(targetSheet, userPassword)
        If Not passwordIsValid Then
            ' Exit for is password is not valid
            Exit For
        End If
    Next targetSheet
    
    
    Select Case passwordIsValid
    Case True
        ' Show message if all sheets were unprotected
        MsgBox "Unprotection completed."
    Case False
        ' Show error password didn't match
        MsgBox "Error-Password Incorrect"
    End Select
    
    ' Run code in "the middle"
    If passwordIsValid Then
        ' Do stuff
        ' INSERT YOUR CODE HERE
        MsgBox "DoStuff"
    End If

    ' Protect all sheets
    For Each targetSheet In ThisWorkbook.Worksheets
        targetSheet.Protect passWord:=internalPassword
    Next targetSheet
    
End Sub

' Credits: https://stackoverflow.com/a/40874679/1521579
Private Function isWorksheetUnprotected(ByVal targetSheet As Worksheet, ByVal passwordString As String) As Boolean
    Dim unprotected As Boolean
    If targetSheet.ProtectContents Then
        On Error GoTo errorLabel
        targetSheet.Unprotect passwordString
        unprotected = True
    Else
        unprotected = True
    End If
errorLabel:
    If Err.Number = 1004 Then Exit Function
    
    isWorksheetUnprotected = unprotected

End Function

让我知道它是否有效！

Answer 2

这是一个简单的模式，您可以通过多种方式使用。

Function SetProtection(ByVal Pw As String, _
                       Optional ByVal Protect As Boolean = True) As Boolean
    ' 125
    ' return Not True if incorrect password was entered
    
    Dim Ws      As Worksheet
    Dim Pword   As String
    
    Pword = InputBox("Enter password")
    SetProtection = True
    If StrComp(Pword, Pw, vbBinaryCompare) Then
        MsgBox "The password you entered is incorrect.", _
               vbCritical, "Access denied"
        SetProtection = False
    Else
        For Each Ws In Worksheets
            With Ws
                .Unprotect Pw
                If Protect Then
                    Debug.Print "protecting"
                    .Protect Password:=Pw, _
                             DrawingObjects:=True, _
                             Contents:=True, _
                             Scenarios:=True, _
                             UserInterfaceOnly:=True, _
                             AllowFormattingCells:=False, _
                             AllowFormattingColumns:=False, _
                             AllowFormattingRows:=False, _
                             AllowInsertingColumns:=False, _
                             AllowInsertingRows:=False, _
                             AllowInsertingHyperlinks:=False, _
                             AllowDeletingColumns:=False, _
                             AllowDeletingRows:=False, _
                             AllowSorting:=False, _
                             AllowFiltering:=False, _
                             AllowUsingPivotTables:=False
                End If
            End With
        Next
    End If
End Function

function 会将用户输入的密码与 function 调用中提供的密码进行比较。 如果不一样，function 将返回 False。 否则它将删除所有纸张上的保护。

如果可选参数Protect为True或省略 function 将继续重新应用保护。 我特意列出了所有属性，以便您可以看到正在执行的操作并轻松进行您可能想要的更改。 您可以删除那些不喜欢的内容，Excel 将使用其默认值。 但是，我提请您注意设置为 True 的属性UserInterFaceOnly 。 这意味着应用的任何保护都不适用于 VBA。 VBA 可以进行更改，但用户不能。 此属性在工作簿关闭之前一直有效。 它无法保存。 因此，您可以调用该过程一次，让您的代码自由工作。 或者您可以调用SetProtection "test", False不会重新应用保护，稍后再次调用SetProtection "test"并应用指定的保护。

这就是您在项目中集成 function 的方式。

Private Sub Test_Pw()

    Dim Pw As String
    Pw = "test"
    
    If SetProtection(Pw) Then
        MsgBox "Execute your code here"
    End If
End Sub

如您所见，如果 function 没有返回 True，那么您不会运行的代码将被跳过，只有输入正确的密码才会返回。