December 7, 2021
I want to protect the content and objects on the sheets in my workbook, but I need my VBA to be able to manipulate them. I thought maybe I could add a named range in the Workbook_Open() procedure and then refer to the value in that range when I need to know what the password is. The problem is that the procedures run but the password is not set when re-protecting the sheets.
Something like this in the "ThisWorkbook" object:
Private Sub Workbook_Open()
Dim ws As Worksheet
' Create a named range called "pswd"
' Assign the value "TrainingHub" to the range
ThisWorkbook.Names.Add "pswd", "TrainingHub"
msgbox "The password is: " & [pswd]
' Now protect every sheet with the password
For Each ws In ThisWorkbook.Worksheets
Debug.Print "Protecting sheet " & ws.Name & " with password " & [pswd]
ws.Protect Password:=[pswd]
' Not sure if I need this or not. And if so, not sure how to use it!
' ws.Protect UserInterFaceOnly:=True
Next ws
End Sub
Sub DoSomething
' Unprotect sheet before action If ProtectSheet (False) = True then debug.print "Unprotect sheet SUCCESS" Else debug.print "Unprotect sheet FAILED" Endif ' Perform some action here, such as adding new slicers (this is why I need to unprotect the sheet) ' Protect the sheet before exiting If ProtectSheet (True) = True then debug.print "Protect sheet SUCCESS" Else debug.print "Protect sheet FAILED" Endif End Sub
Function ProtectSheet (byval bSwitch as boolean) as boolean
ProtectSheet = False If bSwitch = TRUE then ' Protect ActiveSheet.Protect Password:=[pswd], _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True ProtectSheet = True Else ActiveSheet.unprotect password:=[pswd] ProtectSheet = True Endif
End Function
Trusted Members
Moderators
November 1, 2018
December 7, 2021
I got the code to work except for one issue...
Sub ProtectThisSheet() If Not AddProtection(ActiveSheet.Index) Then MsgBox "Failed to protect sheet" Else MsgBox "Protected the sheet" End If End Sub
Function AddProtection(ByVal iSheetIndex As Integer) As Boolean AddProtection = False MsgBox "START -- The sheet index passed is " & iSheetIndex & vbNewLine & "Protected = " & Sheets(iSheetIndex).ProtectContents ' Hard code password for the training hub forum Dim strPswd As String strPswd = "pass123" On Error Resume Next ' This simple line of code works. The sheet gets protected with the password. The msgbox at the end proves it. Sheets(iSheetIndex).Protect Password:=strPswd ' This more complex code FAILS. The sheet does not get protected with any password. The msgbox at the end proves it. ' I am wondering if some property I'm setting is somehow negating the password property ' I want the sheet protected with a password and I need the pivot tables to work, but I want to apply these other restrictions Sheets(iSheetIndex).Protect Password:=strPswd, _ AllowUsingPivotTables:=True, _ DrawingObjects:=False, _ Contents:=False, _ Scenarios:=False, _ AllowFormattingCells:=False, _ AllowFormattingColumns:=False, _ AllowFormattingRows:=False, _ AllowInsertingColumns:=False, _ AllowInsertingRows:=False, _ AllowInsertingHyperlinks:=False, _ AllowDeletingColumns:=False, _ AllowDeletingRows:=False, _ AllowSorting:=False, _ AllowFiltering:=False ' Check whether we were successful If Err.Number = 0 Then AddProtection = True Debug.Print "Protected sheet: " & Sheets(iSheetIndex).Name Else Debug.Print "Failed to protect sheet: " & Sheets(iSheetIndex).Name MsgBox "Failed to protect sheet: " & Sheets(iSheetIndex).Name & _ vbNewLine & "Protection Status = " & UCase(Sheets(iSheetIndex).ProtectContents) End If MsgBox "END -- The sheet index passed is " & iSheetIndex & vbNewLine & "Protected = " & Sheets(iSheetIndex).ProtectContents End Function
Thanks!
1 Guest(s)