Beskyt/afbeskyt alle ark i en projektmappe

Her finder du to makroer. Den første sætter arkbeskyttelse på alle ark i en mappe. Den anden fjerner arkbeskyttelsen fra alle ark. Anvendes password sættes samme password på alle ark, og hvis fjernelsen skal virke, skal arkene ligeledes være beskyttet med samme adgangskode - eller ikke være beskyttede.

Beskyt alle ark
Koden anmoder om adgangskode til beskyttelse. Klikkes OK uden at der skrives noget, beskyttes alle ark uden adgangskode. Indtastes en adgangskode skal denne bekræftes. Er adgangskoden og bekræftelsen ikke identiske, vil man blive bedt om at indtaste den igen, og så fremdeles indtil de to indtastninger er ens. Derefter beskyttes arkene.

Sub BeskytAlle()
    Dim pwa As String
    Dim pwb As String
    Dim adg As String

' Adgangskodeoprettelse
    pwa = InputBox("Indtast adgangskode til beskyttelse og klik OK" & _
       vbCrLf & "Ønskes ingen adgangskode, skal ruden bare stå tom.")       
    If pwa = "" Then
            adg = ""
        Else
            pwb = InputBox("Gentag adgangskoden og klik OK")
            If pwa = pwb Then
                adg = pwb
            Else
                Do Until pwa = pwb
                    pwa = InputBox("Adgangskoderne var ikke ens, tast igen" & _
                       "og klik OK")
                    pwb = InputBox("Gentag adgangskoden og klik OK")
                Loop
                adg = pwb
            End If
        End If 

' Udfør beskyttelsen
    For Each s In ActiveWorkbook.Sheets
        s.Protect Password:=adg
    Next s
End Sub

Afbeskyt alle ark
Koden anmoder om adgangskode til at fjerne beskyttelse. Efterlades ruden tom, svarer det til, at arkene ikke er beskyttet med adgangskode. Virker kun, hvis alle ark er beskyttede med samme adgangskode.

Sub AfbeskytAlle()
    Dim adg As String
    adg = InputBox("Indtast adgangskode")
    On Error GoTo fejl
        For Each s In ActiveWorkbook.Sheets
            s.Unprotect Password:=adg
        Next s
    Exit Sub

fejl:
    If Err.Number = 1004 Then
        MsgBox Err.Description, vbCritical + vbOKOnly
    End If
End Sub