Protection + ekstra funktion

Jeg har lavet en macro der kan låse og oplåse alle ark på engang. Via en inputboks kan man selv bestemme password og filen bliver gemt med dette..

Samtidigt er der nogle ark der bliver gemt når jeg låser arkene.

Problemet er når jeg vil låse op igen. Indsætter jeg Ark1.Visible = xlSheetsvisible i UnProtectAllSheets sub og jeg ikke indtaster noget password eller et forkert så viser den ark1 alligevel men stadig låst. Hvordan får jeg den til ikke at vise ark1 hvis der ikke indtastes password eller et forkert password.

Så den kun viser ark1 ved det rigtige password. 


Dim ws As Worksheet
    Dim sOrigSheet As String
    Dim sOrigCell As String
    Dim sPWord As String
   
Sub ProtectAllSheets()
       
    Application.ScreenUpdating = False
    sOrigSheet = ActiveSheet.Name
    sOrigCell = ActiveCell.Address
   
    On Error Resume Next
    sPWord = InputBox("What password?", "Protect All")
    If sPWord > "" Then
        For Each ws In Worksheets
          ws.Select
            ws.Protect Password:=sPWord
    Next ws
    End If

    Ark1.Visible = xlSheetVeryHidden
    Ark2.Visible = xlSheetVeryHidden
    ark3.Visible = xlSheetVeryHidden
    Application.Goto Reference:=Worksheets("" & sOrigSheet & "").Range("" & sOrigCell & "")
    Application.ScreenUpdating = True
End Sub

Sub UnProtectAllSheets()
   
    Application.ScreenUpdating = False
    sOrigSheet = ActiveSheet.Name
    sOrigCell = ActiveCell.Address
   
    On Error Resume Next
    sPWord = InputBox("What password?", "Unprotect All")
    For Each ws In Worksheets
        If ws.ProtectContents = True Then
        ws.Unprotect Password:=sPWord
        End If
    Next ws
   
    ark1.Visible = xlSheetVisible
    Application.Goto Reference:=Worksheets("" & sOrigSheet & "").Range("" & sOrigCell & "")
    Application.ScreenUpdating = True
End Sub