H
Hans Rattink
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
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