Lösenordskydda arbetsblad och ta bort lösenordskydd

Här visas två fullständiga sätt att dels lösenordskydda samtliga arbetsblad i aktiv arbetsbok och dels ta bort lösenordskyddet för samtliga arbetsblad.

Genom att inhämta lösenordet från en "Application.Input-box" förenklas förfarandet.

Då båda procedurerna får bedömas som rättframma har jag valt att inte kommentera dem.

 

Option Explicit
Private wsBlad As Worksheet
Private stMedd As String, stTitel As String, stSvar As String

Sub Losenordskydda_Arbetsblad()
'© 2002 Alla rättigheter XL-Dennis
stMedd = "Ange ett lösenord eller lämna fältet tomt" & vbCrLf _
               & "för att skydda alla blad i aktiv arbetsbok." & vbCrLf _
               & vbCrLf _
               & "Bladskyddet fungerar även utan lösenord."
 

stTitel = "Lösenordskydda alla arbetsblad"

For Each wsBlad In ActiveWorkbook.Worksheets
     If wsBlad.ProtectContents = True Then
             MsgBox "Ett eller flera blad är redan skyddade" & vbCrLf _
                         & "i den aktiva arbetsboken!" & vbCrLf _
                         & "Verktyget fungerar inte på redan" & vbCrLf _
                         & "skyddade blad.", vbCritical, "Lösenordskydda - systemfel"
             Exit Sub
     End If
Next wsBlad

stSvar = Application.InputBox(Prompt:=stMedd, Title:=stTitel, Default:="", Type:=2)

For Each wsBlad In ActiveWorkbook.Worksheets
     wsBlad.Protect password:=stSvar
Next wsBlad

stSvar = Empty
End Sub

Sub Ta_Bort_Losenordskydd()
'© 2002 Alla rättigheter XL-Dennis
stMedd = "Ange lösenordet för att ta bort bladskydd i aktiv arbetsbok." & vbCrLf _
              & vbCrLf & "Om inget lösenord krävs lämnas fältet tomt."

stTitel = "Ta bort lösenordskydd för alla arbetsblad"

stSvar = Application.InputBox(Prompt:=stMedd, Title:=stTitel, Default:="", Type:=2)

For Each wsBlad In ActiveWorkbook.Worksheets
     If wsBlad.ProtectContents = False Then GoTo Nasta
     wsBlad.Unprotect password:=stSvar
     if Err.Number <> 0 Then
             MsgBox "Felaktigt lösenord!", vbCritical, "Ta bort lösenordskydd - Fel lösenord"
             Exit Sub
     End If
Nasta:
Next wsBlad

End Sub