Sheet Password

[Farah]

Hello,

I want to work on Sheet`s Protection.
I've got a very nice Sheet protection code given by some Excel expert
but it works only on a single sheet. I want to use it for multipl
worksheets. Can this code be changed to be used for multiple Shee
protection?


Dim LastActiveSheet As Worksheet


Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
If Not Sh Is Sheets("Locked") Then
Application.ScreenUpdating = False
Set LastActiveSheet = Sh
End If
End Sub


Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh Is Sheets("Locked") Then
Sh.Visible = True
With Application
.EnableEvents = False
LastActiveSheet.Activate
.EnableEvents = True
End With
PromptForPassword
End If
End Sub


Sub PromptForPassword()
Dim UserInput As Variant
Const PWord1 As String = "abc"
Const PWord2 As String = "xyz"
Const Msg1 As String = "Sheet Locked For Viewing !" & vbNewLine _
& vbNewLine & "Enter Password To Unlock."
Const Msg2 As String = "Wrong Password !"

With Application
Do
UserInput = .InputBox(Msg1)
Select Case UserInput
Case Is = False ' if user cancells don't activat
sheet
Exit Do
Case Is = PWord1, PWord2 ' if password correc
activate sheet4
Set LastActiveSheet = Sheets("Locked")
Exit Do
Case Else 'if wrong password give user another try
UserDecision = MsgBox(Msg2, vbRetryCancel): Beep
End Select
Loop Until UserDecision = vbCancel

Sheets("Locked").Visible = True
.EnableEvents = False
LastActiveSheet.Activate
.EnableEvents = True
End With
End Sub


Thank you.
Regards,

Fara