Try changing the password protection line like this:


ActiveSheet.Protect Password:="hans"

under Protect_Projects


Abdul Salam

-----Original Message-----
Hi all,

I've been looking into the newsgroups but couldn't find
a similar
post.
Here's the problem. I've got two routines. One to
protect a bunch of
sheets and one to unprotect these with the same
password. The password
is hardcoded and doesn't change (see code hereunder). My
OS = W2K,
office 2K (both UK-versions).

The answer the error object returns: "The password you
supplied is not
correct. Verify that the CAPS LOCK key is off and be
sure to use the
correct capitalization."

_________

Sub Unprotect_Projects()

Dim intLoop As Integer
Dim strSheet As String
Dim objWorksheets As Worksheet

On Error GoTo HeHe

strSheet = ActiveSheet.Name

For intLoop = 1 To 500

Set objWorksheets = Sheets(intLoop)
If Val(objWorksheets.Name) 0 Then
objWorksheets.Select
If ActiveSheet.ProtectContents = True Then
ActiveCell.Select
' Call ActiveSheet.Unprotect("hans")
ActiveSheet.Unprotect password:="hans"
Else
Debug.Print "Werkblad " &
objWorksheets.Name
End If
Else
Debug.Print "Naam werkblad " & intLoop & "
niet numeriek "
End If
Next

HeHe:
'Klaar
Debug.Print Error(Err.Number)
Select Case Err.Number
Case 9
Debug.Print "Voorbij het laatste werkblad."
Case otherwise
Debug.Print "Onbekende fout: " & Err.Number
End Select

Debug.Print MsgBox("Laatste rekenblad is: [" &
objWorksheets.Name
& "]")
Worksheets(strSheet).Activate


End Sub


Sub Protect_Projects()

Dim intLoop As Integer
Dim strSheet As String

On Error GoTo HeHe

strSheet = ActiveSheet.Name

For intLoop = 1 To 500

Set objWorksheets = Sheets(intLoop)
If Val(objWorksheets.Name) 0 Then
objWorksheets.Select
If ActiveSheet.ProtectContents = False Then
ActiveSheet.Protect password = "hans",
DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End If
Next


HeHe:
'Klaar

Worksheets(strSheet).Activate

End Sub
.