View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Lostguy Lostguy is offline
external usenet poster
 
Posts: 15
Default Macro to protect and unprotect all sheets of the current workbook

All,

Just wanted to share what finally came out of the guidance I received
from this ng. Maybe this will help someone else. Feedback appreciated:

These macros lets the user protect and unprotect all the sheets within
the current workbook. This macro asks the user for the password rather
than having the password as part of the code itself.
VR/
Lost




Sub UnProtectAllSheets()
Dim ws As Worksheet
Dim sOrigSheet As String
Dim sOrigCell As String
Dim sPWord As String
On Error GoTo Erro

Application.ScreenUpdating = False
sOrigSheet = ActiveSheet.Name
sOrigCell = ActiveCell.Address

sPWord = InputBox("Enter your UnProtect All password:", "UnProtect
All")
If sPWord "" Then
For Each ws In Worksheets
ws.Select
ws.unprotect Password:=sPWord
Next ws
End If
Application.GoTo Reference:=Worksheets("" & sOrigSheet &
"").Range("" & sOrigCell & "")
Application.ScreenUpdating = True
Erro:

Select Case Err
Case 0
MsgBox "Macro completed successfully (or was cancelled by user)."
Case Else
MsgBox "There is something wrong: " & Chr(10) & _
Err & ": " & Err.Description
End Select

Err.Clear

End Sub




Sub ProtectAllSheets()
Dim ws As Worksheet
Dim sOrigSheet As String
Dim sOrigCell As String
Dim sPWord As String
On Error GoTo Erro

Application.ScreenUpdating = False
sOrigSheet = ActiveSheet.Name
sOrigCell = ActiveCell.Address

sPWord = InputBox("Enter your Protect All password:", "Protect
All")
If sPWord "" Then
For Each ws In Worksheets
ws.Select
ws.protect Password:=sPWord
Next ws
End If
Application.GoTo Reference:=Worksheets("" & sOrigSheet &
"").Range("" & sOrigCell & "")
Application.ScreenUpdating = True
Erro:

Select Case Err
Case 0
MsgBox "Macro completed successfully (or was cancelled by user)."
Case Else
MsgBox "There is something wrong: " & Chr(10) & _
Err & ": " & Err.Description
End Select

Err.Clear

End Sub