proteger une cellule

  • Initiateur de la discussion evelynetfrancois
  • Date de début
E

evelynetfrancois

Guest
bonsoir le forum
voici ma Question !!

Est-il possible d empecher la suppression du contenu dune cellule sans passer par la protection de la feuille
par macro disons
et ceux pour une zone definit en colonne A
de A1 à A500

la validation me limite toutes entrées mais n empeche pas la suppression

merci pour vos idées

bonne soirée
E et F
 

Robert

XLDnaute Barbatruc
Bonsoir Evelyne et François, bonsoir le forum,

Je vous propose les deux macros événementielles suivantes mais vous n'avez pas pas intêret à vous planter à la première édition de la plage A1:A500 car après vous ne pourrez plus modifier (sinon en désactivant les macros) :


Private v As Variant 'déclare la variable v

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'au changement de sélection

'Condition : si l 'intersection de la cellule active et de la plage A1:A500 n'est pas vide
'autrement dit, si la cellule active appratient à la plage A1:A500
If Not Application.Intersect(Target, Range('A1:A500')) Is Nothing Then
v = Target.Value 'définit la variable v
End If 'fin de la condition

End Sub

Private Sub Worksheet_Change(ByVal Target As Range) 'au changement d'édition
'Condition 1: si l 'intersection de la cellule active et de la plage A1:A500 n'est pas vide
'autrement dit, si la cellule active appratient à la plage A1:A500
If Not Application.Intersect(Target, Range('A1:A500')) Is Nothing Then

'condition 2 : si v est vide sort de la procédure (permet d'editer une cellule vierge)
If v = '' Then Exit Sub

'empêche l'utilisation des procédures événementielles, autrement dit,
'évite la boucle de cette procédure puisqu'il y a changement d'édition
Application.EnableEvents = False

Target.Value = v 'attibue la variable v à la cible modifié (donc retrouve sa valeur initiale)
End If 'fin de la condition 1

Application.EnableEvents = True 'permet l'utilisation des procédure évenementielles
End Sub

Message édité par: Robert, à: 25/10/2005 22:25
 

myDearFriend!

XLDnaute Barbatruc
Bonsoir evelynetfrancois, Robert,

Une autre proposition :
Private Sub Worksheet_Change(ByVal Target As Range)
      If Not Application.Intersect(Target, Range('A1:A500')) Is Nothing Then
            If Target.Value <> '' Then Application.Undo
      End If
End Sub
Attention toutefois, ce code fonctionnera seulement si les données sont saisies manuellement dans la plage par l'utilisateur. Toute tentative de chargement des cellules par macro entrainera un plantage systématique !

Cordialement,

PS : Robert, je te promets que je ne le fais pas exprès... lol
 

Robert

XLDnaute Barbatruc
Bonjour Evelyne et François, Didier, bonjour le forum,

Bien sûr que je peste, je rage, je reste à la page, je maudis, je blémis, je dénigre, des nègres, des blancs, je râle, je subis, je me rase le pubis, j'invente... des excuses, t'en veux ? Des plates, des profondes, des sincères... Bref je te hais... Didier.

Mais je te aime aussi car après avoir galéré pour trouver mon code, tomber sur le tiens est une leçon que je n'oublierai pas.

Alors surtout continue de n'énerver je t'en remercie.

Robert


Édition

Didier je crois que pour ce que veulent Evelyne et François il faut changer ton code :
If Target.Value <> '' Then Application.Undo
devient
If Target.Value
= '' Then Application.Undo

Et paf !!!


Message édité par: Robert, à: 26/10/2005 11:11
 
E

evelynetfrancois

Guest
bonjour Robert et myDearFriend!
merci pour tout
pour etre franc Robert je m y perdais un peu dans ton code lhi hi hi olll
mais c 'est super !!
avec le code de myDearFriend! corrigé par tes soins , tout va bien
j ai juste rajouté pour eviter un blocage
un 'on resume next' dans la macro
et là ,plus aucun soucis c 'est exatement se que je voulais
encore un grand merci a vous 2 , pour votre savoir et votre dispo
bonne journée
E et F
 
E

evelynetfrancois

Guest
bonjour a tou le forum
j essaye de pas doubler le post puisque meme sujet !!!!

je voudrais bien (si possible evidement ) un complement
de cette macro

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Target, Range('A1:A400')) Is Nothing Then
If Target.Value = '' Then Application.Undo
End If
End Sub

si une seule cellule est considerée , la macro fonctionne parfaitement
(aucuns effacements)
mais si plusieurs cellules le sont , l effacement se fait
malgres tout
donc ma Q est :
est il possible de l ettendre pour plusieurs cellules le cas echeant
merci d avance et bonne journée a tous
E et F
 

myDearFriend!

XLDnaute Barbatruc
Bonjour evelynetfrancois, Robert, le Forum,

Pour tenter de répondre à ton problème, voici une modification qu'il convient de tester :
Private Sub Worksheet_Change(ByVal Target As Range)
      If Not Application.Intersect(Target, Range('A1:A500')) Is Nothing Then
            If ActiveCell.Value = '' Then Application.Undo
      End If
End Sub
Je pense que cette simple modification (remplacement de Target par ActiveCell) devrait être suffisante pour empêcher l'effacement des cellules en sélection par plage...

Par ailleurs, tu précises que 'l'effacement se fait malgré tout'... je t'informe que c'est à cause de (ou grâce à) ton 'on error resume next' que tu n'as pas fait apparaître ici mais dont tu parles plus haut. Sans cette instruction, ça n'efface pas, ça plante !

Cordialement,
 
B

boîte de dialogue s'ouvre sans cess

Guest
Re-bonjour à toutes et à tous!
j'aimerais aussi savoir comment mettre un message d'erreur lorsqu'uine personne essaie de chanfer une valeur dans une cellule non autorisée. J'ai donc écris le code suivant:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range('A1:z1000')) Is Nothing Then
If Target.Value = '' Then
Application.Undo
MsgBox ' aaaaaaaaaa'

End If

Losque j'essai ce code,le message 'aaaaaaa's'ouvre moulte fois (plusieurs dizaines de fois)!!!!!! HELP ME PLEASE! :sick:
 

Discussions similaires

Statistiques des forums

Discussions
300 822
Messages
1 987 481
Membres
209 863
dernier inscrit
habibino