Luttrrt
07-20-2005, 04:37 AM
Hi,
I wrote this code to make my life easier.Might come in handy for somebody else.The first macro protects all sheets in a Spreadsheet and the second unprotects.
The the next Macro Protects the enitre workbook and likewise the next one Unprotects.
All using passwords.
Dim ws As Worksheet
Sub ProtectAll()
Dim S As Object
Dim pWord1 As String, pWord2 As String
pWord1 = InputBox("Please Enter the password")
If pWord1 = "" Then Exit Sub
pWord2 = InputBox("Please re-enter the password")
If pWord2 = "" Then Exit Sub
'make certain passwords are identical
If InStr(1, pWord2, pWord1, 0) = 0 Or _
InStr(1, pWord1, pWord2, 0) = 0 Then
MsgBox "You entered different passwords. No action taken"
Exit Sub
End If
For Each ws In Worksheets
ws.Protect Password:=pWord1
Next
MsgBox "All sheets Protected."
Exit Sub
End Sub
Sub UnProtectAll()
Dim S As Object
Dim pWord3 As String
pWord3 = InputBox("Please Enter the password")
If pWord3 = "" Then Exit Sub
For Each ws In Worksheets
On Error GoTo errorTrap1
ws.Unprotect Password:=pWord3
Next
MsgBox "All sheets UnProtected."
Exit Sub
errorTrap1:
MsgBox "Sheets could not be UnProtected - Password Incorrect"
Exit Sub
End Sub
Sub ProtectWorkbook()
Dim S As Object
Dim pWord3 As String, ShtName As String
pWord5 = InputBox("Please Enter the password")
If pWord5 = "" Then Exit Sub
ShtName = "Workbook as a whole"
On Error GoTo errorTrap1
ActiveWorkbook.Protect Structure:=True, Windows:=False, Password:=pWord5
MsgBox "The workbook's structure has been protected."
Exit Sub
errorTrap1:
MsgBox "Workbook could not be Protected"
Exit Sub
End Sub
Sub UnProtectWorkbook()
Dim S As Object
Dim pWord3 As String, ShtName As String
pWord5 = InputBox("Please Enter the password")
If pWord5 = "" Then Exit Sub
ShtName = "Workbook as a whole"
On Error GoTo errorTrap1
ActiveWorkbook.Unprotect Password:=pWord5
MsgBox "The workbook's structure has been Unprotected."
Exit Sub
errorTrap1:
MsgBox "Workbook could not be UnProtected - Password Incorrect"
Exit Sub
End Sub
Regards,
Rowland
I wrote this code to make my life easier.Might come in handy for somebody else.The first macro protects all sheets in a Spreadsheet and the second unprotects.
The the next Macro Protects the enitre workbook and likewise the next one Unprotects.
All using passwords.
Dim ws As Worksheet
Sub ProtectAll()
Dim S As Object
Dim pWord1 As String, pWord2 As String
pWord1 = InputBox("Please Enter the password")
If pWord1 = "" Then Exit Sub
pWord2 = InputBox("Please re-enter the password")
If pWord2 = "" Then Exit Sub
'make certain passwords are identical
If InStr(1, pWord2, pWord1, 0) = 0 Or _
InStr(1, pWord1, pWord2, 0) = 0 Then
MsgBox "You entered different passwords. No action taken"
Exit Sub
End If
For Each ws In Worksheets
ws.Protect Password:=pWord1
Next
MsgBox "All sheets Protected."
Exit Sub
End Sub
Sub UnProtectAll()
Dim S As Object
Dim pWord3 As String
pWord3 = InputBox("Please Enter the password")
If pWord3 = "" Then Exit Sub
For Each ws In Worksheets
On Error GoTo errorTrap1
ws.Unprotect Password:=pWord3
Next
MsgBox "All sheets UnProtected."
Exit Sub
errorTrap1:
MsgBox "Sheets could not be UnProtected - Password Incorrect"
Exit Sub
End Sub
Sub ProtectWorkbook()
Dim S As Object
Dim pWord3 As String, ShtName As String
pWord5 = InputBox("Please Enter the password")
If pWord5 = "" Then Exit Sub
ShtName = "Workbook as a whole"
On Error GoTo errorTrap1
ActiveWorkbook.Protect Structure:=True, Windows:=False, Password:=pWord5
MsgBox "The workbook's structure has been protected."
Exit Sub
errorTrap1:
MsgBox "Workbook could not be Protected"
Exit Sub
End Sub
Sub UnProtectWorkbook()
Dim S As Object
Dim pWord3 As String, ShtName As String
pWord5 = InputBox("Please Enter the password")
If pWord5 = "" Then Exit Sub
ShtName = "Workbook as a whole"
On Error GoTo errorTrap1
ActiveWorkbook.Unprotect Password:=pWord5
MsgBox "The workbook's structure has been Unprotected."
Exit Sub
errorTrap1:
MsgBox "Workbook could not be UnProtected - Password Incorrect"
Exit Sub
End Sub
Regards,
Rowland