Protection des cellules sauf pour le code VBA Résolu/Fermé

Question

Bonjour à tous et toutes,
 
Mon problème est sans doute "trivial" J'ai en effet trouvé tout plein de messages sur ce même sujet de la protection cellules avec ou via VBA. Mais soit c'est bien plus que ce que je veux faire, soit ça ne répond pas pile poil !

Une feuille de calcul toute simple dont je voudrais protéger toutes les cellules, sauf celles d'une seule colonne 

ça tout seul, c'est hyper simple : verrouillage des cellules et protection de la feuille

Mais le problème, c'est que j'ai du code VBA qui affiche sur la feuille à divers endroits des valeurs ou des messages. Donc, sous VBA, ma feuille ne doit pas être protégée et aucune cellule verrouillée

J'ai bien essayé un Worksheets(1).Unprotect à l'entrée et un Worksheets(1).protect juste avant le end sub 
Mais j'ai quand même une erreur VBA au premier "Range"

Qui peut m'éclairer pour une solution simple sans mot de passe   " 
D'avance un merci grand
Roland

Configuration: Windows 7 / Chrome 27.0.1453.94

jiaco79 · Answer

Bonjour Roland, J'ai essayé qlq chose d'identique pour vérifier la protection et la déprotection des feuilles lors de l'exécution de la procédure principale. J'ai créer deux procédures, une pour déprotèger et une pour protèger. J'appel la première juste avant l'exécution du programme puis j'appel la seconde après l'exécution de la procédure principale le tout en 3 procédures. < Code > 'déprotéger de la feuil3 à l'avant dernière page du classeur Sub Deproteger_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("Feuille_principale").Select Range("A1").Select On Error GoTo 0 Application.ScreenUpdating = True End Sub < \Code > puis < Code > 'Protéger de la feuil3 à l'avant dernière page du classeur Sub Protege_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("Feuille_principale").Select Range("A1").Select On Error GoTo 0 Application.ScreenUpdating = True End Sub < \Code > et enfin procédure principale < Code > Sub restriction_opened() On Error Resume Next Application.ScreenUpdating = False Sheets("Feuille_principale").Activate Range("BA2:BD23").ClearContents Range("BA2").FormulaR1C1 = Application.UserName 'Lève les restrictions d'ouverture pour les noms inscrits dans la liste ci-dessous Range("BB2").Select ActiveCell.Offset(0, 0).Value = "utilisateur1" ActiveCell.Offset(1, 0).Value = "utilisateur2" ActiveCell.Offset(2, 0).Value = "utilisateur3" ActiveCell.Offset(3, 0).Value = "utilisateur4" ActiveCell.Offset(4, 0).Value = "utilisateur5" Range("BB2").Activate On Error Resume Next For Each Cellule In Range("liste_noms") If Cellule.Value = Application.UserName Then Range("BD2").Value = Application.UserName End If Next Application.ScreenUpdating = False If Range("BA2").Value = Range("BD2").Value Then Sheets("Feuille_principale").Activate Range("A1").Select Call Deprotege_DocU Call CalculActions_TraiteNonTraite '<< Procédure principale !! >> Application.ScreenUpdating = True Else Sheets("Feuille_principale").Activate Range("A1").Select Call Deprotege_DocU Call CalculActions_TraiteNonTraite '<< Procédure principale !! >> Call Protege_DocU End If Sheets("Feuille_principale").Select Range("A1").Select Application.ScreenUpdating = True End Sub < \Code > En espèrant que ces bout de lignes de code t'ais éclairé un peu plus, en ce qui me concerne ce petit programme gère toute les entrées et applique une lecture seule en permanence à tout les utilisateurs de ce fichier hors 5 utilisateurs (de 0 à 4). Bon courage et bonne chance jiaco79

lecrol · Answer

Merci jiaco7ç de te pencher sur mon problème

J'ai lu ton code et je me pose plusieurs questions


**** Faut-il obligatoirement associer un mot de passe avec protect ou unprotect ?  Moi j'écrivais simplement Activesheet.protect  = True ( ou False)

En lisant ton code une autre idée me vient à l'esprit
*** Faudrait-il un select avant le protect (ou unprotect) de la feuille ?

Moi je voudrais simplement protéger ( ou l'inverse)  les deux plages de ma feuille A1:G28  et I1:N28 

Mais cette protection n'est que pour protéger mes formules de calcul d'une saisie intempestive de l'utilisateur (ma petite fille de 10 ans)  

Je n'ai pas d'autre besoin de sécurité, ni mot de passe ni confidentialité.
Mais c'est cette protection de base que je n'arrive pas à obtenir.

Merci encore
De mon côté, je vais continuer de fouiner et essayer

Cordialement
Roland

Le Pingou · Answer

Bonjour,
Juste au passage, est-il possible de voir le code de votre procédure ... ?
Ce serait mieux pour comprendre ce que vous désirez au final ... !

eriiic · Answer

Bonjour,

tu peux protéger avec :
sheets("Feuil1").Protect UserInterfaceOnly:=True 

Seul l'utilisateur sera bloqué, les macros n'auront pas besoin de déprotection de la feuille.
Tu le mets dans Workbook_BeforeClose comme ça tu es sûr de ne pas oublier.

eric
 
Jamais tu ne répondras à un mp non sollicité...
Bon, ça c'est fait.

lecrol · Answer

Merci à tous, Voilà ci-dessous les deux procédures que j'ai dans ce dossier (oui, je sais, je pouvais faire une boucle "for next" dans la 1e; Mais ça n'est qu'un jeu de calcul pour ma petite fille La protection de la feuille n'a pour objet que de l'empêcher de saisir en dehors des seules cellules H5:H24 Par contre, toutes les autres doivent être disponibles pour VBA, et verrouilés pour l'utilisateur. Et c'est ça que je n'arrive pas à obtenir Merci encore de votre aide éclairée Cordialement, 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 ' si pas encore joué ' 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) 'Mise en réserve du nombre saisi 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 'si pas de calcul antérieur Range(Ll) = "C'est trop tard !" Range(ML) = 1 GoTo Suit Exam: Range(EL) = Range(HL) 'Mise en réserve du nombre saisi 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 ---------------------------------------------

lecrol · Answer

Eric tu es bien sympa de m'aider

J'ai placé ce code après avoir viré l'autre, et je n'ai plus d'erreur de compil

Mais ne me faut-il pas mettre un "=false" quelque part et un "= True" à un autre endroit ?

Moi j'imaginais déprotéger en entrée de procédure VBA et reprotéger en sortie de procédure. 
Avec le code tel que je l'ai placé (à l'open du dossier, la protection est désactivée et je n'ai donc pas le résultat voulu

Merci de ta patience
Cordialement
Roland

lecrol · Answer

J'ai suivi tes instructions 

1- Sur la feuille, j'active la protection
2- Sur le Wordkbooks, j'ai placé le code suivant ! 
Private Sub Workbook_Open()
    Sheets("Feuil1").Protect UserInterfaceOnly:=True
End Sub

Je ferme mon classeur et je ré-ouvre.... et j'ai une erreur sur cette ligne: 

For Each img In Worksheets("Feuil1").Shapes
        If img.Name = "Bonus" Then ActiveSheet.Shapes("Bonus").Delete
        Next img

avec le message : Erreur 1004 Erreur définie par l'application ou l'objet

Comme te l'indique mon code ( que j'ai publié complètement dans un post plus haut), mon VBA place aussi et efface des images sur la feuille

Y aurait-il une "allergie" entre ces opérations "shapes" et ce code UserInterfaceOnly que j'ai ajouté sur Workbooks ?  Sans doute, car sans ce code je n'ai pas d'erreur ( mais pas non plus de protection)

Merci encore et d'avance
Roland

Le Pingou · Answer

Bonjour à tous,
Je ne sais pas si eriiic (salutations) cherche une solution, personnellement sans voir la configuration du fichier c'est presque impossible de trouver est le problème.
De plus cette instruction se retrouve dans les 2 procédures et vous ne précisez pas l'endroit précis ..... rien à faire .... !
 
Salutations.
Le Pingou

Le Pingou · Answer

Bonjour,
Merci pour l'information, cela correspond à ce que j'ai découvert en partie dans votre code.
Cependant comme préciser par eriiic et moi-même, sans le fichier et ces [Shapes] impossible dans faire plus, désolé.

Le Pingou · Answer

Bonjour,
Ce sera tout pour moi car eriiic vous a proposer une bonne solution (poste 19) que je soutien car j'ai aussi testé sur un fichier fictif et cela fonctionne.
Bonne suite.

lecrol · Answer

Et tant pis si ça ne marche pas en Excel 2003 et exactement avec le code que j'ai publié ici 

Mais merci quand même !
Roland

Le Pingou · Answer

Bonjour,
Je viens de refaire un test sur un fichier construit selon votre code y compris introduction d'image (jpg) et cela fonctionne sans aucun problème et sans utilisation de la proposition d'eriiic (poste 19).
Aucun message d'erreur du au [Shapes].

eriiic · Answer

Je recolle ma proposition apparemment trop perdue dans le fil :

Je viens de tester, effectivement la protection des objets reste.

Donc sans mot de passe, au début de chaque sub en ayant besoin :
Sheets("Feuil1").Unprotect
rétablir à la fin de chaque sub :
Sheets("Feuil1").Protect

Si tu as plusieurs feuilles ou sub tu peux regrouper dans 2 sub que tu appelles partout où c'est nécessaire.
Si tu regardes l'aide sur Protect tu verras que tu peux augmenter les droits de l'utilisateur sur certaines actions.

eric

lecrol · Answer

Alleluja !  Merci, Eric, de ta patience et de ta gentillesse

Je viens de vérifier que tout marchait bien en effet.

Mon erreur, très probablement, a été que je ne conservais pas le code précédent:
   Private Sub Workbook_Open() 
   Sheets("Feuil1").Protect UserInterfaceOnly:=True 
   End Sub 

en mettant le code Sheets("Feuil1").Unprotect  et .Protect

J'ai pensé (bêtement) que le second prenait la place du premier, le rendant inutile.

A présent, j'ai placé les deux codes, le premier en workbooks et le second en début et fin de mes 2 procédures.

Et tout marche bien !

Encore une fois merci. Merci à toi et Le Pingou. Désolé de ne pas m'être assez bien expliqué et de vous avoir ainsi pris de votre temps.

Mais là, je vais pouvoir enfin faire travailler ses tables de multiplication à ma petite fille de 12 ans (son bac est encore loin )
Merci encore à vous deux et bravo pour ce forum!
Roland

Le Pingou · Answer

Bonjour lecrol,
Content pour vous.
Juste au passage, votre fille de 12 ans va avoir son bac beaucoup plus vite que vous le pensez si en 2 jours elle prend 2 ans .....(ma petite fille de 10 ans / poste 3)... !
Bonne semaine.

Protection des cellules sauf pour le code VBA

15 réponses

Discussions similaires