Macro / protection

Le
Erico
Bonjour à tous,

J'ai un problème avec cette macro, la protection se remet pas automatiquement.
Cette macro met les caractères en rouges quand il y a un changement dans la
cellule.


Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="Regie" '__________désactive la protection
If Target.Count > 1 Then Exit Sub
Set isect1 = Application.Intersect(Target, Range("A17:BJ90"))
Set isect2 = Application.Intersect(Target, Range("A96:BJ141"))
Set isect3 = Application.Intersect(Target, Range("A146:BJ166"))
Set isect4 = Application.Intersect(Target, Range("A172:BJ209"))
'____________
If Not isect1 Is Nothing Or Not isect2 Is Nothing Or Not isect3 Is _
Nothing _
Or Not isect4 Is Nothing Then Target.Font.ColorIndex = 3
'_________________
If Target.Column <> 56 Then Exit Sub
If Not IsNumeric(Target.Value) Then Exit Sub
Target.Offset(0, 1).Value = Target.Offset(0, 1).Value + Target.Value
ActiveSheet.Protect Password:="Regie" '______________ l'active
End Sub
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Erico
Le #4354011
Le problème, c'Est que je n'ai pas toujours des cellules proteger, il
faudrait une condition "si" il est proteger sur tout pour l'addition à la fin
de la macro.

Je vais essayer de déplacer l'enlèvement de la protection plus vers la fin.


Bonjour à tous,

J'ai un problème avec cette macro, la protection se remet pas automatiquement.
Cette macro met les caractères en rouges quand il y a un changement dans la
cellule.


Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="Regie" '__________désactive la protection
If Target.Count > 1 Then Exit Sub
Set isect1 = Application.Intersect(Target, Range("A17:BJ90"))
Set isect2 = Application.Intersect(Target, Range("A96:BJ141"))
Set isect3 = Application.Intersect(Target, Range("A146:BJ166"))
Set isect4 = Application.Intersect(Target, Range("A172:BJ209"))
'____________
If Not isect1 Is Nothing Or Not isect2 Is Nothing Or Not isect3 Is _
Nothing _
Or Not isect4 Is Nothing Then Target.Font.ColorIndex = 3
'_________________
If Target.Column <> 56 Then Exit Sub
If Not IsNumeric(Target.Value) Then Exit Sub
Target.Offset(0, 1).Value = Target.Offset(0, 1).Value + Target.Value
ActiveSheet.Protect Password:="Regie" '______________ l'active
End Sub


Youky
Le #4353991
Au lieu des exitsub je le fais aller à "fin" avec la bonne vieille méthode
du goto qui n'est plus bien employée
mais qui marche du tonnerre
Youky
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="Regie" '__________désactive la protection
If Target.Count > 1 Then Goto fin
Set isect1 = Application.Intersect(Target, Range("A17:BJ90"))
Set isect2 = Application.Intersect(Target, Range("A96:BJ141"))
Set isect3 = Application.Intersect(Target, Range("A146:BJ166"))
Set isect4 = Application.Intersect(Target, Range("A172:BJ209"))
'____________
If Not isect1 Is Nothing Or Not isect2 Is Nothing Or Not isect3 Is _
Nothing _
Or Not isect4 Is Nothing Then Target.Font.ColorIndex = 3
'_________________
If Target.Column <> 56 Then Goto fin
If Not IsNumeric(Target.Value) Then Goto fin
Target.Offset(0, 1).Value = Target.Offset(0, 1).Value + Target.Value
fin:
ActiveSheet.Protect Password:="Regie" '______________ l'active
End Sub
MichDenis
Le #4353971
J'ai réécrit ta macro... mais je ne suis pas certain d'avoir tout compris

à quoi sert cette ligne de code dans ta macro ?
| If Target.Count > 1 Then Exit Sub


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range, Arr
If Target.Count > 1 Then Exit Sub
ActiveSheet.Protect Password:="Regie"
Application.EnableEvents = False
Arr = Array("A17:BJ90", "A96:BJ141", "A146:BJ166", "A172:BJ209")
For Each elt In Arr
Set Rg = Intersect(Range(elt), Target)
If Not Rg Is Nothing Then
For Each c In Rg
If IsNumeric(c) Then
c.Offset(0, 1).Value = c.Offset(0, 1).Value + c.Value
c.Font.ColorIndex = 3
End If
Next
Rg.Font.ColorIndex = 3
End If
Next
ActiveSheet.Protect Password:="Regie"
Application.EnableEvents = True
End Sub





"Erico"
Bonjour à tous,

J'ai un problème avec cette macro, la protection se remet pas automatiquement.
Cette macro met les caractères en rouges quand il y a un changement dans la
cellule.


Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="Regie" '__________désactive la protection
If Target.Count > 1 Then Exit Sub
Set isect1 = Application.Intersect(Target, Range("A17:BJ90"))
Set isect2 = Application.Intersect(Target, Range("A96:BJ141"))
Set isect3 = Application.Intersect(Target, Range("A146:BJ166"))
Set isect4 = Application.Intersect(Target, Range("A172:BJ209"))
'____________
If Not isect1 Is Nothing Or Not isect2 Is Nothing Or Not isect3 Is _
Nothing _
Or Not isect4 Is Nothing Then Target.Font.ColorIndex = 3
'_________________
If Target.Column <> 56 Then Exit Sub
If Not IsNumeric(Target.Value) Then Exit Sub
Target.Offset(0, 1).Value = Target.Offset(0, 1).Value + Target.Value
ActiveSheet.Protect Password:="Regie" '______________ l'active
End Sub
MichDenis
Le #4353961
Attention la deuxième occurrence de cette ligne de code
c.Font.ColorIndex = 3 a été oubliée... supprime la.



"MichDenis"
J'ai réécrit ta macro... mais je ne suis pas certain d'avoir tout compris

à quoi sert cette ligne de code dans ta macro ?
| If Target.Count > 1 Then Exit Sub


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range, Arr
If Target.Count > 1 Then Exit Sub
ActiveSheet.Protect Password:="Regie"
Application.EnableEvents = False
Arr = Array("A17:BJ90", "A96:BJ141", "A146:BJ166", "A172:BJ209")
For Each elt In Arr
Set Rg = Intersect(Range(elt), Target)
If Not Rg Is Nothing Then
For Each c In Rg
If IsNumeric(c) Then
c.Offset(0, 1).Value = c.Offset(0, 1).Value + c.Value
c.Font.ColorIndex = 3
End If
Next
Rg.Font.ColorIndex = 3
End If
Next
ActiveSheet.Protect Password:="Regie"
Application.EnableEvents = True
End Sub





"Erico"
Bonjour à tous,

J'ai un problème avec cette macro, la protection se remet pas automatiquement.
Cette macro met les caractères en rouges quand il y a un changement dans la
cellule.


Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="Regie" '__________désactive la protection
If Target.Count > 1 Then Exit Sub
Set isect1 = Application.Intersect(Target, Range("A17:BJ90"))
Set isect2 = Application.Intersect(Target, Range("A96:BJ141"))
Set isect3 = Application.Intersect(Target, Range("A146:BJ166"))
Set isect4 = Application.Intersect(Target, Range("A172:BJ209"))
'____________
If Not isect1 Is Nothing Or Not isect2 Is Nothing Or Not isect3 Is _
Nothing _
Or Not isect4 Is Nothing Then Target.Font.ColorIndex = 3
'_________________
If Target.Column <> 56 Then Exit Sub
If Not IsNumeric(Target.Value) Then Exit Sub
Target.Offset(0, 1).Value = Target.Offset(0, 1).Value + Target.Value
ActiveSheet.Protect Password:="Regie" '______________ l'active
End Sub
Erico
Le #4332011
Rien ne fonctionne.

voici la macro et tu m'As demander de cacher une ligne.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range, Arr
If Target.Count > 1 Then Exit Sub
ActiveSheet.Protect Password:="Regie"
Application.EnableEvents = False
Arr = Array("A17:BJ90", "A96:BJ141", "A146:BJ166", "A172:BJ209")
For Each elt In Arr
Set Rg = Intersect(Range(elt), Target)
If Not Rg Is Nothing Then
For Each c In Rg
If IsNumeric(c) Then
c.Offset(0, 1).Value = c.Offset(0, 1).Value + c.Value
'c.Font.ColorIndex = 3
End If
Next
Rg.Font.ColorIndex = 3
End If
Next
ActiveSheet.Protect Password:="Regie"
Application.EnableEvents = True
End Sub

"MichDenis"
Attention la deuxième occurrence de cette ligne de code
c.Font.ColorIndex = 3 a été oubliée... supprime la.



"MichDenis"
J'ai réécrit ta macro... mais je ne suis pas certain d'avoir tout compris

à quoi sert cette ligne de code dans ta macro ?
| If Target.Count > 1 Then Exit Sub


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range, Arr
If Target.Count > 1 Then Exit Sub
ActiveSheet.Protect Password:="Regie"
Application.EnableEvents = False
Arr = Array("A17:BJ90", "A96:BJ141", "A146:BJ166", "A172:BJ209")
For Each elt In Arr
Set Rg = Intersect(Range(elt), Target)
If Not Rg Is Nothing Then
For Each c In Rg
If IsNumeric(c) Then
c.Offset(0, 1).Value = c.Offset(0, 1).Value + c.Value
c.Font.ColorIndex = 3
End If
Next
Rg.Font.ColorIndex = 3
End If
Next
ActiveSheet.Protect Password:="Regie"
Application.EnableEvents = True
End Sub





"Erico"
Bonjour à tous,

J'ai un problème avec cette macro, la protection se remet pas
automatiquement.
Cette macro met les caractères en rouges quand il y a un changement dans
la
cellule.


Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="Regie" '__________désactive la
protection
If Target.Count > 1 Then Exit Sub
Set isect1 = Application.Intersect(Target, Range("A17:BJ90"))
Set isect2 = Application.Intersect(Target, Range("A96:BJ141"))
Set isect3 = Application.Intersect(Target, Range("A146:BJ166"))
Set isect4 = Application.Intersect(Target, Range("A172:BJ209"))
'____________
If Not isect1 Is Nothing Or Not isect2 Is Nothing Or Not isect3 Is _
Nothing _
Or Not isect4 Is Nothing Then Target.Font.ColorIndex = 3
'_________________
If Target.Column <> 56 Then Exit Sub
If Not IsNumeric(Target.Value) Then Exit Sub
Target.Offset(0, 1).Value = Target.Offset(0, 1).Value + Target.Value
ActiveSheet.Protect Password:="Regie" '______________ l'active
End Sub





Erico
Le #4331891
La macro de Youky qui fonctionne le mieux.

Merci a vous deux.


"Erico"
Rien ne fonctionne.

voici la macro et tu m'As demander de cacher une ligne.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range, Arr
If Target.Count > 1 Then Exit Sub
ActiveSheet.Protect Password:="Regie"
Application.EnableEvents = False
Arr = Array("A17:BJ90", "A96:BJ141", "A146:BJ166", "A172:BJ209")
For Each elt In Arr
Set Rg = Intersect(Range(elt), Target)
If Not Rg Is Nothing Then
For Each c In Rg
If IsNumeric(c) Then
c.Offset(0, 1).Value = c.Offset(0, 1).Value + c.Value
'c.Font.ColorIndex = 3
End If
Next
Rg.Font.ColorIndex = 3
End If
Next
ActiveSheet.Protect Password:="Regie"
Application.EnableEvents = True
End Sub

"MichDenis"
Attention la deuxième occurrence de cette ligne de code
c.Font.ColorIndex = 3 a été oubliée... supprime la.



"MichDenis"
J'ai réécrit ta macro... mais je ne suis pas certain d'avoir tout compris

à quoi sert cette ligne de code dans ta macro ?
| If Target.Count > 1 Then Exit Sub


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range, Arr
If Target.Count > 1 Then Exit Sub
ActiveSheet.Protect Password:="Regie"
Application.EnableEvents = False
Arr = Array("A17:BJ90", "A96:BJ141", "A146:BJ166", "A172:BJ209")
For Each elt In Arr
Set Rg = Intersect(Range(elt), Target)
If Not Rg Is Nothing Then
For Each c In Rg
If IsNumeric(c) Then
c.Offset(0, 1).Value = c.Offset(0, 1).Value + c.Value
c.Font.ColorIndex = 3
End If
Next
Rg.Font.ColorIndex = 3
End If
Next
ActiveSheet.Protect Password:="Regie"
Application.EnableEvents = True
End Sub





"Erico" news:

Bonjour à tous,

J'ai un problème avec cette macro, la protection se remet pas
automatiquement.
Cette macro met les caractères en rouges quand il y a un changement dans
la
cellule.


Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="Regie" '__________désactive la
protection
If Target.Count > 1 Then Exit Sub
Set isect1 = Application.Intersect(Target, Range("A17:BJ90"))
Set isect2 = Application.Intersect(Target, Range("A96:BJ141"))
Set isect3 = Application.Intersect(Target, Range("A146:BJ166"))
Set isect4 = Application.Intersect(Target, Range("A172:BJ209"))
'____________
If Not isect1 Is Nothing Or Not isect2 Is Nothing Or Not isect3 Is _
Nothing _
Or Not isect4 Is Nothing Then Target.Font.ColorIndex = 3
'_________________
If Target.Column <> 56 Then Exit Sub
If Not IsNumeric(Target.Value) Then Exit Sub
Target.Offset(0, 1).Value = Target.Offset(0, 1).Value + Target.Value
ActiveSheet.Protect Password:="Regie" '______________ l'active
End Sub









Publicité
Poster une réponse
Anonyme