PDA

View Full Version : How to create one button for locking/unlocking all sheets



ACM
12-21-2010, 09:36 AM
Okay, so currently I have this code:

Option Explicit
Sub UnlockAllSheets()
'Unlocks all worksheets in workbook
Dim i As Integer
On Error Resume Next
For i = 1 To Sheets.Count
Worksheets(i).Unprotect Password:="password" 'Change to your password here
Next i
End Sub
'Locks all worksheets in workbook
Sub LockAllSheets()
Dim i As Integer
On Error Resume Next
For i = 1 To Sheets.Count
Worksheets(i).Protect Password:="password" 'Change to your password here
Next i
End Sub


At the moment, I'm just using two separate buttons to lock/unlock all sheets in the workbook. How do I merge this code into one so the same button unlocks/locks the sheets?

Bob Phillips
12-21-2010, 09:48 AM
Sub AllSheetsProtetction()
Dim i As Long

On Error Resume Next
For i = 1 To Sheets.Count

With Worksheets(i)

If .ProtectContents Then

.Unprotect Password:="password" 'Change to your password here
Else

.Protect Password:="password" 'Change to your password here
End If
End With
Next i
End Sub

ACM
12-21-2010, 10:20 AM
Sub AllSheetsProtetction()
Dim i As Long

On Error Resume Next
For i = 1 To Sheets.Count

With Worksheets(i)

If .ProtectContents Then

.Unprotect Password:="password" 'Change to your password here
Else

.Protect Password:="password" 'Change to your password here
End If
End With
Next i
End SubThanks, however, can I ask how it's possible to make worksheets exempt from being locked? I have one worksheet called "Options" which I'd like to keep unlocked when the button is pressed.

Also, how do I attach a password to the button, so whenever it is clicked, the user has to enter a password? That code doesn't seem to pop-up a password box for some reason.

Bob Phillips
12-21-2010, 10:45 AM
Sub AllSheetsProtetction()
Dim i As Long

On Error Resume Next
For i = 1 To Sheets.Count

With Worksheets(i)

If .Name <> "Options" Then

If .ProtectContents Then

.Unprotect Password:="password" 'Change to your password here
Else

.Protect Password:="password" 'Change to your password here
End If
End If
End With
Next i
End Sub