Unlocking shape/textbox in VBA

[UK_Kiwi]

Hi,

I have created a VBA code via record macro which inserts a shape with text into a worksheet as a note to other users. The code works perfectly, however, I would like to protect the sheet so users don't delete formulas etc. When I protect the sheet, the activated Macro works, however the text box can not be deleted once the user has read it. The vba code already unlocks/locks the sheet to run certain aspects of the code, and now I need to figure out how and where I need to add an unlock function to the shape code. I have copied the section of my code that should be relevant.

ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 286.0714173228, 300 _
, 559.2857480315, 289.2857480315).Select
Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 20
Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
"1. Save as new file version number (xxxxx.v?.0)" & Chr(13) & "" & Chr(13) & "2. Turn on Auto Save" & Chr(13) & "" & Chr(13) & "3. Paste new Procim download in detailed breakdown Tab ready for next issue" & Chr(13) & "" & Chr(13) & "4. Delete this text box" & Chr(13) & "" & Chr(13) & "5. Repeat for each estimate version"
Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 48).ParagraphFormat. _
FirstLineIndent = 0
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 48).Font
.Bold = msoTrue
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Fill.Transparency = 0
.Fill.Solid
.Size = 20
.Name = "+mn-lt"
End With

Code in between sets colour and font to text

With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 4.5
End With
Selection.ShapeRange.ScaleWidth 1.2030651017, msoFalse, msoScaleFromTopLeft
Worksheets("Budget Summary").Protect "*****"
End Sub

Advice and guidance appreciated for a long time reader, first time poster

Thanks

SW

 

[DanteAmor]

Hi @UK_Kiwi Welcome to the MrExcel forum. Please accept my warmest greetings and sincere hope that all is well.

Change this line:

Worksheets("Budget Summary").Protect "*****"

For this:

Worksheets("Budget Summary").Protect "*****", DrawingObjects:=False

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

 

[UK_Kiwi]

Hi Dante,

Absolutely brilliant and makes perfect sense that it should go there!! Ha ha ha.

Thank you

SW