Qualifying permissions in protect unprotect macro.

  • Thread starter Thread starter Colin Hayes
  • Start date Start date
C

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.
 
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
 
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()
 
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.
 
Back
Top