CODEWITHSUNDEEP
excelvba
r z
r z

Reputation: 99

VBA: Protect Sheet but allow editing of specific object types

I would like to allow users of my document to edit specific shapes on my sheet, namely Shape.Type = msoOvalShapes

However, when I protect my sheet with DrawingObjects:=False, ALL objects can be edited, including for example, pictures and rectangles that I would like to remain stationary and untouched.

I've done some research, but haven't found an example of someone restricting drawingobjects to only specific object types. Below is my current Workbook_Open protocol. 

Private Sub Workbook_Open()

Application.ScreenUpdating = False
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")

ws.Activate
ActiveWindow.Zoom = 100

With ws
   .Protect Password:="", UserInterfaceOnly:=True
   .EnableOutlining = True
   .Protect DrawingObjects:=False, Contents:=True, Scenarios:=True
End With
Application.ScreenUpdating = True

End Sub

Is it possible to protect specific objects in a worksheet?

Upvotes: 0

Views: 3834

Answers (1)

r z
r z

Reputation: 99

When you do the default '.Protect', for example within ThisWorbook > Sub Workbook_Open, all items that are locked via the Properties tab within the excel application worksheet cannot be moved or edited.

However, when new objects/shapes are added via Command Buttons, they too are locked.

To change it so newly added objects/shapes are not locked, I went into my Sub which creates the object and set the "Locked" property of any new object added via this Sub to False. Here's my code for example:

Sub AddShape()
Dim s As Shape
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")

Set s = ws.Shapes.AddShape(msoShapeOval, 775 + w * 3, 100 + w * 2, 20, 20)
s.TextFrame.Characters.Text = w
s.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
s.TextFrame2.VerticalAnchor = msoAnchorMiddle
s.Fill.BackColor.RGB = RGB(250, 0, 0)
s.Fill.ForeColor.RGB = RGB(250, 0, 0)
s.Locked = False                       'This is the crucial part

End Sub

Back in my WorkBook_Open sub, I'm not calling of DrawingObjects under the Protect feature. For Example:

Sub Workbook_Open()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
ws.Activate
'Protect the worksheet from being edited
With ws
   .Protect Password:="", UserInterfaceOnly:=True
   .EnableOutlining = True
   .Protect Contents:=True, Scenarios:=True

'Notice how DrawingObjects is not included, thus the default Protect is use

End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Now everytime my CommandButton calls AddShape, a new circle appears that is movable and editable. Any shape that I locked via the Properties tab is NOT movable nor editable. Solved. Thank you dwirony for leading me in the right direction.

Upvotes: 1

Related Questions