Fjern arkbeskyttelse på alle ark (hvis de er paswordbeskyttet)

Denne kode fjerner beskyttelsen fra alle ark. Du kan evt. modificere denm til også at kunne fjerne fra markerede ark - eller jeg kan gøre det snere i aften.

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

Der er lidt "ballade" når man har valgt flere ark - og gerne vil unprotect. Så man bliver nødt til at "un-group" og bagefter "re-group"... Det er alt sammen herunder:


Sub unprotect()
Dim vsheet As Worksheet
Dim pw As String
Dim shts As Sheets
    Set shts = ActiveWindow.SelectedSheets
    'Un-group
    ActiveSheet.Select
    answ = MsgBox("Fjern beskyttelsen fra alle ark?" & vbLf & vbLf & "'Ja':  Alle ark" & vbLf & "'Nej': Valgte ark", vbQuestion + vbYesNoCancel)
   
    If answ <> vbCancel Then
        pw = InputBox("Indtast password", "Password")
        If answ = vbYes Then
            For Each vsheet In Sheets
                vsheet.unprotect pw
            Next
        Else
            For Each vsheet In shts
                vsheet.unprotect pw
            Next
        End If
    End If
    'Re-group
    shts.Select
   
End Sub

Og det skulle selvfølgelig have været et svar.... Det er det her så  :)

Tak for hjælpen til jer begge.

Sager løser hele opgaven og har dermed fået alle point.

Tak TVC