Protecting multiple worksheet simultaneously 1

[mohtogh]

Hi,
How can I protect two or more worksheets not separately?
I know about Tools> Protection> Protect worksheet , but how can I do this once for all of my worksheet?(protecting through Protect workbook has not "strong" protection ).
Thanks

 

[Denial]

As far as I know, the only way to do this is with a VBA macro. My effort is reproduced below, FWIW. Needless to say, it comes with less guarantees than a fifth-hand Trabant. If you use it frequently, set the two subs up with shortcuts: say Ctrl-Shift-P and Ctrl-Shift-U.

- - - - Code begins - - - -[tt]

Option Explicit

Sub Protect_All()
'
' Macro to apply a password to all sheets in a workbook, and to the workbook itself.
'
Dim WorkSht As Worksheet
Dim PassWd, High_Sec, ShtName As String, StartShtName As String
Const Descr As String = "Macro to protect all worksheets"
'
' Get some necessary info from the user: First the level of protection required; Then
' the password to be used.
' (Note that the "Application." in front of the "InputBox" for the latter is necessary
' to be able to distinguish between a blank password and a "cancel" response, since with it
' a cancel will return a boolean "false", while without it a cancel will return an empty
' string.)
'
High_Sec = MsgBox("Do you wish to restrict the cursor to unlocked cells only " & _
"(to hide formulae etc)?", vbYesNoCancel + vbDefaultButton2, Descr)
If High_Sec = vbCancel Then
MsgBox "Operation cancelled at your request.", vbOKOnly, Descr
Exit Sub
End If
'
PassWd = Application.InputBox("Please enter the password you want to use:", Descr)
If VarType(PassWd) = vbBoolean Then
If Not PassWd Then
MsgBox "Operation cancelled at your request.", vbOKOnly, Descr
Exit Sub
End If
End If
'
' Record the presently-active sheet, so we can return to it when finished.
'
StartShtName = ActiveSheet.Name
'
' Loop through all the worksheets.
'
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
If High_Sec = vbYes Then
ActiveSheet.EnableSelection = xlUnlockedCells
Else
ActiveSheet.EnableSelection = xlNoRestrictions
End If
On Error GoTo 0
MsgBox "Sheet """ & ShtName & """ has been protected.", vbOKOnly, Descr
Next WorkSht
'
' Now protect the workbook.
'
On Error GoTo P_Failure
ShtName = "Workbook as a whole"
ActiveWorkbook.Protect Structure:=True, Windows:=False, Password:=PassWd
On Error GoTo 0
MsgBox "The workbook's structure has been protected.", vbOKOnly, Descr
'
' Return whence we starteth-ed, then it's all over.
'
Worksheets(StartShtName).Activate
MsgBox "All done OK. Password used was """ & PassWd & """." & Chr(13) & Chr(13) & _
"Don't 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
Dim PassWd, ShtName As String, StartShtName As String
Const Descr As String = "Macro to unprotect all worksheets"
'
' Get the password from the user.
'
PassWd = Application.InputBox("Please enter the password:", Descr)
If VarType(PassWd) = vbBoolean Then
If Not PassWd Then
MsgBox "Operation cancelled at your request.", vbOKOnly, Descr
Exit Sub
End If
End If
'
' Record the presently-active sheet, so we can return to it when finished.
'
StartShtName = ActiveSheet.Name
'
' Loop through all the worksheets.
'
For Each WorkSht In Worksheets
WorkSht.Activate
ShtName = ActiveSheet.Name
On Error GoTo U_Failure
ActiveSheet.Unprotect Password:=PassWd
On Error GoTo 0
MsgBox "Sheet """ & ShtName & """ has been unprotected.", vbOKOnly, Descr
Next WorkSht
'
' Now unprotect the workbook.
'
On Error GoTo U_Failure
ShtName = "Workbook as a whole"
ActiveWorkbook.Unprotect Password:=PassWd
On Error GoTo 0
MsgBox "The workbook's structure has been unprotected.", vbOKOnly, Descr
'
' Return whence we starteth-ed, then it's all over.
'
Worksheets(StartShtName).Activate
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

[/tt]- - - - Code ends - - - -

 

[analogkid2digitalman]

Denial:

Nicely written code! I like the tip about the Application.InputBox, that always bugged me trying to do it without the Application.

 

[jhardy1]

At the risk of repeating myself, here is my standard reply to a lot of "How can I ..." in Excel:

Download a free copy of ASAP Utilities from

http://www.asap-utilities.com.

Once installed, you are one mouse click away from "Protect All Sheets", which will protect all worksheets simultaneously with the same password. Is this what you are after?

(Plus you get about another 299 useful Excel utilities, all for the unbeatable price of $0.00. Everyone should have a copy installed!)

 

[jmw]

Thanks Julian,
Done.

JMW

http://www.viscoanalyser.com

Eng-Tips: Pro bono publico, by engineers, for engineers.

Please see FAQ731-376 for tips on how to make the best use of Eng-Tips Fora.