For what it's worth, here's the VBA listing for the two complementary macros. I believe that you should be able to cut&paste directly into a VBA module, even though the line wrapping below looks ugly.
Note that you will have to edit in your chosen password in two places. You will also have to create the necessary shortcuts (if you want them). Finally, if you did it all in an otherwise empty spreadsheet, you can convert it all to an add-in, which will make life a bit easier when you actually come to use the macros.
[tt]
------ Macros begin ------
Option Explicit
Option Base 1
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
Sub Protect_All()
'
' Macro to apply a hardwired password to all sheets in a workbook and to the workbook itself.
'
Dim WorkSht As Worksheet, NumbSheets As Integer
Dim PassWd, Ans, ShtName As String, StartShtName As String
Const Descr As String = "Macro to protect all worksheets"
'
' Warn user what is about to happen.
'
Ans = MsgBox("You are about to protect all sheets in this workbook." & _
Chr(13) & Chr(13) & "Do you wish to continue?", _
vbYesNoCancel + vbDefaultButton1, Descr)
If Ans = vbCancel Or Ans = vbNo Then
MsgBox "Operation cancelled at your request.", vbOKOnly, Descr
Exit Sub
End If
'
' Set the "hard-wired" password.
'
PassWd = "PutYourPasswordHere"
'
' Record the presently-active sheet, so we can return to it when finished.
'
StartShtName = ActiveSheet.Name
'
' Loop through all the worksheets.
'
NumbSheets = 0
For Each WorkSht In Worksheets
WorkSht.Activate
ShtName = ActiveSheet.Name
On Error GoTo P_Failure
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=PassWd
ActiveSheet.EnableSelection = xlNoRestrictions
On Error GoTo 0
NumbSheets = NumbSheets + 1
Next WorkSht
'
' Now protect the workbook.
'
ShtName = "Workbook's structure"
On Error GoTo P_Failure
ActiveWorkbook.Protect Structure:=True, Windows:=False, Password:=PassWd
On Error GoTo 0
'
' Return whence we starteth-ed, then it's all over.
'
Worksheets(StartShtName).Activate
MsgBox "All done OK (" & NumbSheets & " sheets)." & Chr(13) & Chr(13) & _
"Password used was """ & PassWd & """." & Chr(13) & Chr(13) & _
"Take care not to forget it.", vbOKOnly, Descr
Exit Sub
'
' Error handling area.
'
P_Failure:
MsgBox "Protection attempt failed for """ & ShtName & """ so exercise was aborted." & _
Chr(13) & Chr(13) & _
Err & ": " & Error(Err), _
vbOKOnly, Descr
End Sub
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
Sub Unprotect_All()
'
' Macro to unprotect all sheets in a workbook, and the workbook itself.
' It assumes that all these protections have been set with the same password.
'
Dim WorkSht As Worksheet, NumbSheets As Integer, Ans
Dim PassWd, ShtName As String, StartShtName As String
Const Descr As String = "Macro to unprotect all worksheets"
'
' Warn user what is about to happen.
'
Ans = MsgBox("You are about to unprotect all sheets in this workbook." & _
Chr(13) & Chr(13) & "Do you wish to continue?", _
vbYesNoCancel + vbDefaultButton1, Descr)
If Ans = vbCancel Or Ans = vbNo Then
MsgBox "Operation cancelled at your request.", vbOKOnly, Descr
Exit Sub
End If
'
' Set the "hard-wired" password.
'
PassWd = "PutYourPasswordHere"
'
' Record the presently-active sheet, so we can return to it when finished.
'
StartShtName = ActiveSheet.Name
'
' Loop through all the worksheets.
'
NumbSheets = 0
For Each WorkSht In Worksheets
WorkSht.Activate
ShtName = ActiveSheet.Name
On Error GoTo U_Failure
ActiveSheet.Unprotect Password:=PassWd
On Error GoTo 0
NumbSheets = NumbSheets + 1
Next WorkSht
'
' Now unprotect the workbook.
'
ShtName = "Workbook's structure"
On Error GoTo U_Failure
ActiveWorkbook.Unprotect Password:=PassWd
On Error GoTo 0
'
' Return whence we starteth-ed, then it's all over.
'
Worksheets(StartShtName).Activate
MsgBox "All done OK (" & NumbSheets & " sheets).", vbOKOnly, Descr
Exit Sub
'
' Error handling area.
'
U_Failure:
MsgBox "Unprotection attempt failed for """ & ShtName & """ so exercise was aborted." & _
Chr(13) & Chr(13) & _
Err & ": " & Error(Err), _
vbOKOnly, Descr
End Sub
------ Macros end ------
[/tt]
Happy passwording.
![[ponder]](/data/assets/smilies/ponder.gif "[ponder] [ponder]")
