如何使用密碼取消保護工作簿、運行代碼、重新保護工作簿？

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，那么您不會運行的代碼將被跳過，只有輸入正確的密碼才會返回。