Protecting cells except for VBA code

Hello Roland,

I tried something similar to verify the protection and unprotection of sheets during the execution of the main procedure. I created two procedures, one to unprotect and one to protect. I call the first one just before executing the program and then I call the second one after executing the main procedure, all in 3 procedures.

< Code >

'Unprotecting from Sheet3 to the second last page of the workbook
Sub Unprotect_doc()
Dim I

Application.ScreenUpdating = False

On Error Resume Next

For I = 3 To Sheets.Count - 1

Sheets(I).Activate
Range("D10").Select

ActiveSheet.Unprotect Password:="risks2"

Next I

Sheets("Main_Sheet").Select
Range("A1").Select

On Error GoTo 0

Application.ScreenUpdating = True

End Sub

< \Code >

then

< Code >

'Protecting from Sheet3 to the second last page of the workbook
Sub Protect_Doc()
Dim I

Application.ScreenUpdating = False

On Error Resume Next

For I = 3 To Sheets.Count - 1

Sheets(I).Activate
Range("D10").Select

ActiveSheet.Protect Password:="risks2"

Next I

Sheets("Main_Sheet").Select
Range("A1").Select

On Error GoTo 0

Application.ScreenUpdating = True

End Sub

< \Code >

and finally the main procedure

< Code >

Sub restriction_opened()

On Error Resume Next

Application.ScreenUpdating = False

Sheets("Main_Sheet").Activate
Range("BA2:BD23").ClearContents

Range("BA2").FormulaR1C1 = Application.UserName

'Lifting the opening restrictions for the names listed below
Range("BB2").Select
ActiveCell.Offset(0, 0).Value = "user1"
ActiveCell.Offset(1, 0).Value = "user2"
ActiveCell.Offset(2, 0).Value = "user3"
ActiveCell.Offset(3, 0).Value = "user4"
ActiveCell.Offset(4, 0).Value = "user5"
Range("BB2").Activate

On Error Resume Next

For Each Cell In Range("name_list")
If Cell.Value = Application.UserName Then
Range("BD2").Value = Application.UserName
End If
Next

Application.ScreenUpdating = False

If Range("BA2").Value = Range("BD2").Value Then

Sheets("Main_Sheet").Activate
Range("A1").Select

Call Unprotect_DocU

Call CalculateActions_ProcessedNotProcessed '<< Main Procedure !! >>

Application.ScreenUpdating = True

Else

Sheets("Main_Sheet").Activate
Range("A1").Select

Call Unprotect_DocU

Call CalculateActions_ProcessedNotProcessed '<< Main Procedure !! >>

Call Protect_DocU

End If

Sheets("Main_Sheet").Select
Range("A1").Select

Application.ScreenUpdating = True

End Sub

< \Code >

Hoping these lines of code have shed some light for you, as far as I'm concerned, this little program manages all entries and applies a read-only status permanently to all users of this file except for 5 users (from 0 to 4).

Good luck and good courage

jiaco79

Thank you jiaco7ç for addressing my issue

I read your code and I have several questions

**** Do I necessarily have to associate a password with protect or unprotect? I was simply writing ActiveSheet.Protect = True (or False)

After reading your code, another idea comes to mind
*** Should there be a select before the protect (or unprotect) of the sheet?

I simply want to protect (or the opposite) the two ranges of my sheet A1:G28 and I1:N28

But this protection is only to protect my calculation formulas from an unwanted input by the user (my 10-year-old granddaughter)

I have no other security needs, no password or confidentiality.
But it's this basic protection that I can't seem to achieve.

Thank you again
On my side, I will continue to dig around and try

Best regards
Roland

Hello,
Just passing by, is it possible to see the code of your procedure ...?
It would be better to understand what you ultimately desire ...!

--
Best regards.
The Penguin

Hello,

you can protect with:
sheets("Sheet1").Protect UserInterfaceOnly:=True

Only the user will be blocked, the macros will not need to unprotect the sheet.
You put it in Workbook_BeforeClose so you are sure not to forget.

eric

Never reply to an unsolicited DM...
Well, that's done.

Thank you all,
Here are the two procedures I have in this folder (yes, I know, I could have made a "for next" loop in the first one; but it's just a calculation game for my little girl.

The sheet protection is only meant to prevent her from entering data outside the cells H5:H24.

However, all other cells must be available for VBA and locked for the user. And that's what I can't achieve.

Thank you again for your enlightened help.
Sincerely,
Roland
----------------------------------------------------------------------------
Private Sub CommandButton1_Click()
Dim img As Shape
For Each img In Worksheets("Feuil1").Shapes
If img.Name = "Bonus" Then ActiveSheet.Shapes("Bonus").Delete
Next img
'
For Each img In Worksheets("Feuil1").Shapes
If img.Name = "Cible" Then ActiveSheet.Shapes("Cible").Delete
Next img
'
Range("F5") = Int((8 * Rnd) + 2)
Range("F6") = Int((8 * Rnd) + 2)
Range("F7") = Int((8 * Rnd) + 2)
Range("F8") = Int((8 * Rnd) + 2)
Range("F9") = Int((8 * Rnd) + 2)
Range("F10") = Int((8 * Rnd) + 2)
Range("F11") = Int((8 * Rnd) + 2)
Range("F12") = Int((8 * Rnd) + 2)
Range("F13") = Int((8 * Rnd) + 2)
Range("F14") = Int((8 * Rnd) + 2)
Range("F15") = Int((8 * Rnd) + 2)
Range("F16") = Int((8 * Rnd) + 2)
Range("F17") = Int((8 * Rnd) + 2)
Range("F18") = Int((8 * Rnd) + 2)
Range("F19") = Int((8 * Rnd) + 2)
Range("F20") = Int((8 * Rnd) + 2)
Range("F21") = Int((8 * Rnd) + 2)
Range("F22") = Int((8 * Rnd) + 2)
Range("F23") = Int((8 * Rnd) + 2)
Range("F24") = Int((8 * Rnd) + 2)
'
Range("g5") = Int((8 * Rnd) + 2)
Range("g6") = Int((8 * Rnd) + 2)
Range("g7") = Int((8 * Rnd) + 2)
Range("g8") = Int((8 * Rnd) + 2)
Range("g9") = Int((8 * Rnd) + 2)
Range("g10") = Int((8 * Rnd) + 2)
Range("g11") = Int((8 * Rnd) + 2)
Range("g12") = Int((8 * Rnd) + 2)
Range("g13") = Int((8 * Rnd) + 2)
Range("g14") = Int((8 * Rnd) + 2)
Range("g15") = Int((8 * Rnd) + 2)
Range("g16") = Int((8 * Rnd) + 2)
Range("g17") = Int((8 * Rnd) + 2)
Range("g18") = Int((8 * Rnd) + 2)
Range("g19") = Int((8 * Rnd) + 2)
Range("g20") = Int((8 * Rnd) + 2)
Range("g21") = Int((8 * Rnd) + 2)
Range("g22") = Int((8 * Rnd) + 2)
Range("g23") = Int((8 * Rnd) + 2)
Range("g24") = Int((8 * Rnd) + 2)
'
Range("h5:h24") = ""
Range("E5:E24") = ""
Range("L5:M24") = "" '
Var = Time() '
Range("K4") = Var
End Sub
---------------------------------------------------------
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'
Dim L As Integer
Dim img As Shape
Dim repi As String
Dim repc As String
Dim EL As String
Dim JL As String
Dim KL As String
Dim HL As String
Dim Hlsuit As String
Dim Ll As String
Dim ML As String
'
'
For L = 5 To 24
repi = "c:\Jeu calcul\Im" & CStr(L - 4) & ".jpg"
repc = "c:\Jeu calcul\Ct" & CStr(L - 4) & ".jpg"
EL = "E" & CStr(L)
HL = "H" & CStr(L)
Hlsuit = "H" & CStr(L + 1)
KL = "L" & CStr(L)
JL = "K" & CStr(L)
Ll = "L" & CStr(L)
ML = "M" & CStr(L)
'
If Range("H5") = "" Then GoTo Fin ' if not played yet
'
If Target.Column = 8 And Target.Row = L Then
If Range(JL) = 0 Then
For Each img In Worksheets("Feuil1").Shapes
If img.Name = "cible" Then ActiveSheet.Shapes("Cible").Delete
Next img
Range(EL) = Range(HL) 'Reserve the entered number
Range("N5").Select
ActiveSheet.Pictures.Insert(repi).Select
Selection.Name = "Cible"
If L < 24 Then Range(Hlsuit).Select
'
ElseIf Range(JL) = 1 Then
For Each img In Worksheets("Feuil1").Shapes
If img.Name = "Bonus" Then ActiveSheet.Shapes("Bonus").Delete
Next img
If Range(EL) = "" Then GoTo Exam 'if no previous calculation
Range(Ll) = "Too late!"
Range(ML) = 1
GoTo Suit
Exam:
Range(EL) = Range(HL) 'Reserve the entered number
Range("B5").Select
ActiveSheet.Pictures.Insert(repc).Select
Selection.Name = "Bonus"
If L < 24 Then Range(Hlsuit).Select
End If
End If
'
Suit:
Next L
'
Fin:
If Range("H27") = 20 Then
Range("P20").Select
ActiveSheet.Pictures.Insert("c:\Jeu calcul\Champion Medaille.jpg").Select
Selection.Name = "Bonus"
Range("B20").Select
ActiveSheet.Pictures.Insert("c:\Jeu calcul\Champion Vainqueur.jpg").Select
Selection.Name = "Bonus"
GoTo Sortie
End If
'
If Range("H24") = "" Then GoTo R1
If Range("H27") > 14 Then
Range("P20").Select
ActiveSheet.Pictures.Insert("c:\Jeu calcul\Champion_Coupe.jpg").Select
Selection.Name = "Bonus"
GoTo Sortie
End If
'
R1:
If Range("H24") = "" Then GoTo R2
If Range("H27") > 9 Then
Range("P20").Select
ActiveSheet.Pictures.Insert("c:\Jeu calcul\Moyen.jpg").Select
Selection.Name = "Bonus"
GoTo Sortie
End If
'
R2:
If Range("H24") = "" Then GoTo Sortie
If Range("H27") < 9 And Range("H27") >= 0 Then
Range("p20").Select
ActiveSheet.Pictures.Insert("c:\Jeu calcul\Non.jpg").Select
Selection.Name = "Bonus"
Range("B20").Select
ActiveSheet.Pictures.Insert("c:\Jeu calcul\Non_2.jpg").Select
Selection.Name = "Bonus"
End If
Sortie:
'
End Sub
---------------------------------------------

Eric, you are very nice to help me.

I placed this code after removing the other one, and I no longer have a compilation error.

But don't I need to put a "false" somewhere and a "True" somewhere else?

I imagined unprotecting at the beginning of the VBA procedure and re-protecting at the end of the procedure.
With the code as I placed it (at the opening of the folder, the protection is disabled and therefore I don't have the desired result.

Thank you for your patience.
Best regards,
Roland

I followed your instructions

1- On the sheet, I activate the protection
2- In the Workbooks, I placed the following code!
Private Sub Workbook_Open()
Sheets("Feuil1").Protect UserInterfaceOnly:=True
End Sub

I close my workbook and re-open it... and I have an error on this line:

For Each img In Worksheets("Feuil1").Shapes
If img.Name = "Bonus" Then ActiveSheet.Shapes("Bonus").Delete
Next img

with the message: Error 1004 Application defined or object defined error

As indicated by my code (which I published completely in a previous post), my VBA also places and deletes images on the sheet

Could there be an "allergy" between these "shapes" operations and the UserInterfaceOnly code I added on Workbooks? Probably, because without this code I have no error (but also no protection)

Thank you again in advance
Roland

Hello everyone,
I don't know if eriiic (greetings) is looking for a solution, personally without seeing the configuration of the file it's almost impossible to pinpoint the problem.
Moreover, this instruction is found in both procedures and you do not specify the exact location ..... nothing to do .... !

Best regards.
Le Pingou

Hello,
Thank you for the information, it corresponds to what I partially discovered in your code.
However, as pointed out by eriiic and myself, without the file and these [Shapes] it's impossible to do more, sorry.

--
Regards.
The Penguin

Hello,
That will be all for me as eriiic has proposed a good solution (post 19) that I support because I also tested it on a fictional file and it works.
Have a good continuation.

--
Regards.
The Penguin

And too bad if it doesn't work in Excel 2003 and exactly with the code I published here

But thanks anyway!
Roland

Hello,
I just retested a file built according to your code including image introduction (jpg) and it works without any problem and without using eriiic's suggestion (post 19).
No error message from [Shapes].

--
Best regards.
The Penguin

I am reposting my proposal which seems to be too lost in the thread:

I just tested, indeed the protection of the objects remains.

So without a password, at the beginning of each sub that needs it:
Sheets("Feuil1").Unprotect
restore at the end of each sub:
Sheets("Feuil1").Protect

If you have multiple sheets or subs, you can group them into 2 subs that you call wherever necessary.
If you look at the help on Protect, you will see that you can increase the user's rights on certain actions.

eric

--
Never reply to an unsolicited private message...
Well, that’s done.

Allelujah! Thank you, Eric, for your patience and kindness.

I just checked that everything was working fine indeed.

My mistake, very likely, was that I wasn't keeping the previous code:
Private Sub Workbook_Open()
Sheets("Feuil1").Protect UserInterfaceOnly:=True
End Sub

by using the code Sheets("Feuil1").Unprotect and .Protect.

I (foolishly) thought that the second one replaced the first, making it unnecessary.

Now, I placed both codes, the first in workbooks and the second at the beginning and end of my two procedures.

And everything is working well!

Once again, thank you. Thanks to you and Le Pingou. I'm sorry for not explaining myself well enough and for thus taking your time.

But now, I will finally be able to teach my 12-year-old granddaughter her multiplication tables (her exam is still far away).
Thank you both again and well done for this forum!
Roland

Hello lecrol,
Happy for you.
Just by the way, your 12-year-old daughter is going to get her diploma much faster than you think if in 2 days she takes 2 years.....(my little girl is 10 years old / post 3)... !
Have a good week.

--
Best regards.
Le Pingou