Excel Worksheet Password Protect Problem

[joecolombo]

I am not a programmer. Can anyone tell me why this code will not work. It is used in an Excel worksheet to password protect it from viewing.

Private Sub Worksheet_Activate()
'password protect your VBA project
Dim strPassword As String
On Error Resume Next
Const Password = "123" '**Change password here**


Me.Protect Password:=Password
Me.Columns.Hidden = True


strPassword = InputBox("Enter password to view this sheet", "Password
required !")


If strPassword = "" Then
Me.Previous.Select
Exit Sub
ElseIf strPassword <> Password Then
MsgBox "Password Incorrect", , "Wrong password"
Me.Previous.Select
Exit Sub
Else
Me.Unprotect Password:=Password
Me.Columns.Hidden = False
End If


On Error GoTo 0
End Sub


Private Sub Worksheet_Deactivate()
On Error Resume Next
Me.Columns.Hidden = True
On Error GoTo 0
End Sub

 

[WinblowsME]

Put the following in ThisWorkbook

Private Sub Workbook_Activate()
   Const pass As String = "123"
   Dim response As String
   
   Call Hide_Sheets(True)
   
   response = InputBox("Enter password to view this sheet", "Password Required !")

   If response <> pass Then
      MsgBox ("Wrong password.")
      Call Save_Quit
   Else
      Call Hide_Sheets(False)
   End If
End Sub

Private Sub Workbook_Deactivate()
   Call Save_Quit
End Sub

Private Sub Hide_Sheets(flag As Boolean)
   Dim s As Integer
   
   For s = 1 To Sheets.Count
      If flag Then
         Sheets(s).Cells.EntireColumn.Hidden = True
      Else
         Sheets(s).Cells.EntireColumn.Hidden = False
      End If
   Next s
End Sub

Private Sub Save_Quit()
   Call Hide_Sheets(True)
   
   Application.DisplayAlerts = False
   Application.ActiveWorkbook.Save
   Application.Quit
End Sub