VBA/Excel/Access/Word/Excel/Worksheet Protection

Add protection to Worksheet

   <source lang="vb">

Sub Set_Protection()

   On Error GoTo errorHandler
   Dim myDoc As Worksheet
   Dim cel As Range
   Set myDoc = ActiveSheet
   myDoc.Unprotect
   For Each cel In myDoc.UsedRange
       cel.Locked = True
       cel.Font.ColorIndex = xlColorIndexAutomatic
   Next
   myDoc.Protect
   Exit Sub
   errorHandler:
   MsgBox Error

End Sub

</source>
   
  

Add user edit range

   <source lang="vb">

Sub AddUserEditRange()

   Dim ws As Worksheet, aer As AllowEditRange
   Set ws = ThisWorkbook.Sheets("Protection")
   ws.Unprotect "Excel2003"
   Set aer = ws.Protection.AllowEditRanges.Add("User Range", ws.Range("A1:D4"))
   aer.Users.Add "Power Users", True
   ws.Protect "Excel2003"

End Sub

</source>
   
  

Formulas Protection

   <source lang="vb">

Sub ProtectFormulas()

   Dim ws As Worksheet, rng As Range
   Set ws = ThisWorkbook.Sheets("Protection")
   ws.Unprotect
   " Get each used cell in the worksheet.
   For Each rng In ws.UsedRange
       " If it contains a formula, lock the cell.
       If InStr(rng.Formula, "=") Then
           rng.Locked = True
       " Otherwise unlock the cell.
       Else
           rng.Locked = False
       End If
   Next
   ws.Protect "Excel2003"

End Sub

</source>
   
  

Protecting Worksheet Assets with the Protect Method

   <source lang="vb">

Sub TestProtection()

   Dim ws As Worksheet 
   Set ws = ThisWorkbook.Worksheets(1) 
   If Not ProtectWorksheet(ws, "TestPassword") Then 
       Debug.Print "The worksheet could not be protected." 
   Else 
       Debug.Print "The worksheet has been protected." 
   End If 
   If UnprotectWorksheet(ws, "TestPassword") Then 
       Debug.Print "The worksheet has been unprotected." 
   Else 
       Debug.Print "The worksheet could not be unprotected." 
   End If 
   Set ws = Nothing 

End Sub Function ProtectWorksheet(ws As Worksheet, sPassword As String) As Boolean

   On Error GoTo ErrHandler 
   If Not ws.ProtectContents Then 
       ws.Protect sPassword, True, True, True 
   End If 
   ProtectWorksheet = True 
   Exit Function 

ErrHandler:

   ProtectWorksheet = False 

End Function Function UnprotectWorksheet(ws As Worksheet, sPassword As String) As Boolean

   On Error GoTo ErrHandler 
   If ws.ProtectContents Then 
       ws.Unprotect sPassword 
   End If 
   UnprotectWorksheet = True 
   Exit Function 

ErrHandler:

   UnprotectWorksheet = False 

End Function

</source>
   
  

Protect Sheet

   <source lang="vb">

Sub ProtectSheet()

   Dim ws As Worksheet
   Set ws = ThisWorkbook.Sheets("Protection")
   ws.Protect "Excel2003", , True, , True
   ws.Range("A1").Value = 42
   Debug.Print ws.ProtectContents
   Debug.Print ws.ProtectDrawingObjects
   Debug.Print ws.ProtectionMode
   Debug.Print ws.ProtectScenarios

End Sub

</source>
   
  

remove user

   <source lang="vb">

Sub RemoveUser()

   Dim ws As Worksheet, rng As Range, aer As AllowEditRange
   Set ws = ThisWorkbook.Sheets("Protection")
   ws.Unprotect
   Set aer = ws.Protection.AllowEditRanges("User Range")
   aer.Users("Power Users").Delete

End Sub

</source>
   
  

Remove user edit range

   <source lang="vb">

Sub RemoveUserEditRange()

   Dim ws As Worksheet, rng As Range, aer As AllowEditRange
   Set ws = ThisWorkbook.Sheets("Protection")
   ws.Unprotect
   For Each aer In ws.Protection.AllowEditRanges
       aer.Delete
   Next

End Sub

</source>
   
  

Show Protection Properties

   <source lang="vb">

Sub ShowProtectionProperties()

   Dim ws As Worksheet, prot As Protection
   Set ws = ThisWorkbook.Sheets("Protection")
   Set prot = ws.Protection
   Debug.Print prot.AllowDeletingColumns
   Debug.Print prot.AllowDeletingRows
   Debug.Print prot.AllowFiltering
   Debug.Print prot.AllowSorting
   Debug.Print prot.AllowUsingPivotTables
   Debug.Print prot.AllowFormattingCells
   Debug.Print prot.AllowFormattingColumns
   Debug.Print prot.AllowFormattingRows
   Debug.Print prot.AllowInsertingColumns
   Debug.Print prot.AllowInsertingRows
   Debug.Print prot.AllowInsertingHyperlinks

End Sub

</source>
   
  

Unprotect worksheet

   <source lang="vb">

Sub UnprotectWS()

   Dim ws As Worksheet
   Set ws = ThisWorkbook.Sheets("Protection")
   ws.Unprotect "Excel2003"

End Sub

</source>