Qualifying permissions in protect unprotect macro.

[Colin Hayes]

HI All

I wonder if someone can help with a small puzzle.

I use this macro to protect / unprotect the sheets in my workbook :

Sub Protect_Unprotect()


Const PWORD As String = "Password"
Dim wkSht As Worksheet
Dim statStr As String

For Each wkSht In ActiveWorkbook.Worksheets
With wkSht
statStr = statStr & vbNewLine & "Sheet " & .Name
If .ProtectContents Then
wkSht.Unprotect Password:=PWORD
statStr = statStr & ": Unprotected"
Else
wkSht.Protect Password:=PWORD
statStr = statStr & ": Protected"
End If
End With
Next wkSht
MsgBox Mid(statStr, 2)


End Sub


I'm trying to add into the code these qualifying permissions when the
macro protects and unprotects :


DrawingObjects:=False, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowFiltering:=True


I can't seem to place these in the correct place in the code without
errors.

Can someone advise where the code should be placed so that it works?

Grateful for any advice.

 

[Gord Dibben]

Sub Protect_Unprotect()


Const PWORD As String = "Password"
Dim wkSht As Worksheet
Dim statStr As String

For Each wkSht In ActiveWorkbook.Worksheets
With wkSht
statStr = statStr & vbNewLine & "Sheet " & .Name
If .ProtectContents Then
wkSht.Unprotect Password:=PWORD
statStr = statStr & ": Unprotected"
Else
wkSht.Protect Password:=PWORD, _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowFiltering:=True
statStr = statStr & ": Protected"
End If
End With
Next wkSht
MsgBox Mid(statStr, 2)

End Sub


Gord Dibben MS Excel MVP

 

[GS]

Colin Hayes presented the following explanation :

HI All

I wonder if someone can help with a small puzzle.

I use this macro to protect / unprotect the sheets in my workbook :

Sub Protect_Unprotect()


Const PWORD As String = "Password"
Dim wkSht As Worksheet
Dim statStr As String

For Each wkSht In ActiveWorkbook.Worksheets
With wkSht
statStr = statStr & vbNewLine & "Sheet " & .Name
If .ProtectContents Then
wkSht.Unprotect Password:=PWORD
statStr = statStr & ": Unprotected"
Else
wkSht.Protect Password:=PWORD
statStr = statStr & ": Protected"
End If
End With
Next wkSht
MsgBox Mid(statStr, 2)


End Sub


I'm trying to add into the code these qualifying permissions when the macro
protects and unprotects :


DrawingObjects:=False, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowFiltering:=True


I can't seem to place these in the correct place in the code without errors.

Can someone advise where the code should be placed so that it works?

Grateful for any advice.

Colin,
Those protection options are only set when applying protection.
Unprotecting removes the permissions.

Take a look at the wksProtect procedure in the Calendar.xlt to see how
these are applied. Instructions are there for how to include/exclude
each one by placement BEFORE the comment tag (apostrophe) in the list.
(This is after the 4th permission (AllowFormattingCells:=True ', _).
Just relocate the apostrophe and/or move the permissions around
(reorder them) to suit your needs.

Sub wksProtect(Optional WksName As String)
' Protects specified sheets according to Excel version.
' Assumes Public Const PWRD as String contains the password, even if
there isn't one.
'
' Arguments: WksName [In] Optional.
' The name of the sheet to be protected.
' Defaults to ActiveSheet.Name if missing.

If IsMissing(WksName) Then WksName = ActiveSheet.Name
On Error Resume Next
With Sheets(WksName)
If Val(Application.Version) >= 10 Then
'Copy/paste the desired parameters above the commented line.
.Protect Password:=PWRD, DrawingObjects:=False, _
Contents:=True, Scenarios:=True, _
Userinterfaceonly:=True, _
AllowFiltering:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowFormattingCells:=True ', _
AllowDeletingColumns:=True, _
AllowDeletingRows:=True, _
AllowInsertingColumns:=True, _
AllowInsertingHyperlinks:=True, _
AllowInsertingRows:=True, _
AllowUsingPivotTables:=True
Else
.Protect Password:=PWRD, _
DrawingObjects:=False, _
Contents:=True, Scenarios:=True, _
Userinterfaceonly:=True
End If
.EnableAutoFilter = True
.EnableOutlining = True

.EnableSelection = xlNoRestrictions
' .EnableSelection = xlUnlockedCells
' .EnableSelection = xlNoSelection
End With
End Sub

To unprotect a sheet simply...

Sheets("Sheet1").Unprotect Password:=PWRD

OR
To unprotect all sheets in a workbook...

Dim wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
wks.Unprotect Password:=PWRD
Next

HTH

 

[GS]

I forgot to post a sample of how to protect...

Dim wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
wksProtect wks.Name
Next

OR
wksProtect "Sheet1" 'pass the sheetname

OR
wksProtect 'to apply to activesheet

I have a revised version of wksProtect that takes a ref to the sheet
instead of a sheetname, so I can ref any sheet in any open workbook.
For example:

To protect all sheets in a workbook...
Dim wks As Worksheet
For Each wks In Workbooks("Book1").Worksheets
wksProtect wks
Next

OR
To protect a single sheet...
wksProtect Workbooks("Book1").Sheets(1)

Sub wksProtect(Optional Wks As Worksheet)
' Protects specified sheets according to Excel version.
' Assumes Public Const PWRD as String contains the password, even if
there isn't one.
'
' Arguments: Wks [In] Optional. The sheet to be protected.
' Defaults to ActiveSheet if missing.

If Wks Is Nothing Then Set Wks = ActiveSheet
On Error Resume Next
With wks
If Val(Application.Version) >= 10 Then
'Copy/paste the desired parameters above the commented line.
.Protect Password:=PWRD, DrawingObjects:=False, _
Contents:=True, Scenarios:=True, _
Userinterfaceonly:=True, _
AllowFiltering:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowFormattingCells:=True ', _
AllowDeletingColumns:=True, _
AllowDeletingRows:=True, _
AllowInsertingColumns:=True, _
AllowInsertingHyperlinks:=True, _
AllowInsertingRows:=True, _
AllowUsingPivotTables:=True
Else
.Protect Password:=PWRD, DrawingObjects:=False, _
Contents:=True, Scenarios:=True, Userinterfaceonly:=True
End If
.EnableAutoFilter = True
.EnableOutlining = True

.EnableSelection = xlNoRestrictions
' .EnableSelection = xlUnlockedCells
' .EnableSelection = xlNoSelection
End With
End Sub 'wksProtect()

 

[Colin Hayes]

Hi

OK thanks for that. This is a macro I've been using for some time now ,
and just wanted it to be a little more sophisticated. I realise I can
switch some of these permissions off and on as necessary by judicious
use of the rem apostrophe.

Thanks again.