Retaining Existing Excel Worksheet Protection When Enabling Grouping

Question

I'm trying to allow grouping in worksheets (EnableOutlining). Below is a typical example that allows it but it also resets all of the protection attributes as specified. Unfortunately I don't know what the existing attributes are. Is there a simple way of retaining the existing protection attributes when I set the grouping attribute?

Private Sub Workbook_Open()
' Modified from http://www.clickconsulting.com/forum/excel-support/grouping-protected-worksheet
' NOTE: It is not necessary to unprotect a worksheet to change the protection settings.
' Reference: https://exceloffthegrid.com/vba-code-worksheet-protection/
' https://stackoverflow.com/questions/37419714/unprotect-sheet-prompt-for-pw-only-when-allowfiltering-true?rq=1

Dim pw As String

pw = "Secret"
For Each ws In Sheets
   With ws
        If .ProtectContents = True Then
           .Protect Password:=pw, UserInterfaceOnly:=True
           .EnableOutlining = True
       End If
    End With
Next ws

End Sub

How do I retain existing settings rather than overwrite them?

.Protect Password:=pw, _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=False, _
UserInterfaceOnly:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingColumns:=True, _
AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, _
AllowDeletingColumns:=True, _
AllowDeletingRows:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True

I'd welcome any comments on how to manage a hard-coded password too.

This looks particularly useful https://powerspreadsheets.com/excel-vba-worksheets/#How-To-Read-A-Worksheet8217s-Protection-Settings I will see if i can write something quick based on this — QHarr, Jan 16 '18 at 05:10
I so far have only been able to think of a one way to do this.... to write a set of If statements that test the True/False condition of each of the [protection properties](https://msdn.microsoft.com/en-us/vba/excel-vba/articles/protection-object-excel) of the protection object for the current worksheet. — QHarr, Jan 16 '18 at 06:40
It seems wrong that original settings are lost when the protection is re-enabled. @QHarr - saving each property and retrieving is the only thing I can imagine too and will work. I imagined there might be some way of saving collection of all protection attributes properties then all except ones to be changed and changing those to be changed. — flywire, Jan 16 '18 at 09:36

QHarr · Accepted Answer · 2018-01-17T17:39:53.610

This is a little long winded but uses a function to collect the current protection properties in a dictionary and then uses those dictionary settings to set the protection when locking again. I haven't code for all conditions (listed at bottom). This could be revised to produce a dictionary of dictionaries to capture for the different sheets or deploy the function in a loop. I would welcome feedback on how to improve this.

Option Explicit

Public myDict As Scripting.Dictionary

Sub test()

    Dim wb As Workbook
    Dim ws As Worksheet

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet2")

    Set myDict = WorksheetProtectionSettings(ws)

    ws.Unprotect Password:="password"

    ws.Protect Password:="password", DrawingObjects:=myDict("ProtectDrawingObjects"), Contents:=myDict("ProtectContents") 'ToDo: extend with other arguments.......

End Sub

Private Function WorksheetProtectionSettings(ByVal ws As Worksheet) As Dictionary
'tools > references > ms scripting runtime library

Set myDict = New Scripting.Dictionary

With ws

    If .ProtectDrawingObjects = True Then
        myDict.Add "ProtectDrawingObjects", True
    Else
        myDict.Add "ProtectDrawingObjects", False
    End If

    If .ProtectContents = True Then
        myDict.Add "ProtectContents", True
    Else
        myDict.Add "ProtectContents", False
    End If

    'ToDo: Add other conditions.......

End With

Set WorksheetProtectionSettings = myDict

End Function

'https://msdn.microsoft.com/en-us/vba/excel-vba/articles/worksheet-protect-method-excel
'Password
'Worksheet.ProtectDrawingObjects
'Worksheet.ProtectContents
'Worksheet.ProtectScenarios
'Worksheet.ProtectionMode
'Protection.AllowFormattingCells
'Protection.AllowFormattingColumns
'Protection.AllowFormattingRows
'Protection.AllowInsertingColumns
'Protection.AllowInsertingRows
'Protection.AllowInsertingHyperlinks
'Protection.AllowDeletingColumns
'Protection.AllowDeletingRows
'Protection.AllowSorting
'Protection.AllowFiltering
'Protection.AllowUsingPivotTables

Thanks to @TimWilliams it seems I can also access those properties commencing with "Protect" via then CallByName function:

Dim result As Boolean
result = CallByName(ws, "ProtectDrawingObjects", VbGet)
MsgBox result

More info given on this in Tim's answer to my question here.

Retaining Existing Excel Worksheet Protection When Enabling Grouping

1 Answers1

Linked