Fjerne arkbeskyttelse på alle og beskytte alle ark

Hej

Det kan gøres med en simpel macro

Sub LaasAlt()
    For Each s In ActiveWorkbook.Sheets
          s.Protect Password:="SKRIV DIN KODE"
    Next s
End Sub


Sub LaasAltOp()
    For Each s In ActiveWorkbook.Sheets
          s.Unprotect Password:="SKRIV DIN KODE"
    Next s
End Sub

Eller en lidt udvidet variant, hvor adgangskoden ikke står direkte i  koden.

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

og

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

Klikker du OK til dialogboksen i første makro uden at taste noget, bweskyttes uden adgangskode. Det samme gælder, når du skal "afbeskytte".

Tusind tak for det. Det virker jo bare. Jkrons lægger du lige et svar så I kan dele nogle points ?

Det er bare for fedt at jeg slipper for alle de klik.

Her er et svar.

Tak for hjælpen

Velbekomme :-)