Macro / protection

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

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

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" <Erico@discussions.microsoft.com> a écrit dans le message de news:
905910B2-5FEE-4C01-A11D-420DC3D4A5AC@microsoft.com...
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

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



"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
e27RoWbYHHA.448@TK2MSFTNGP04.phx.gbl...
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" <Erico@discussions.microsoft.com> a écrit dans le message de news:
905910B2-5FEE-4C01-A11D-420DC3D4A5AC@microsoft.com...
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

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" <michdenis@hotmail.com> a écrit dans le message de news:
OB0MXZbYHHA.3928@TK2MSFTNGP02.phx.gbl...

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



"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
e27RoWbYHHA.448@TK2MSFTNGP04.phx.gbl...
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" <Erico@discussions.microsoft.com> a écrit dans le message de news:
905910B2-5FEE-4C01-A11D-420DC3D4A5AC@microsoft.com...
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

La macro de Youky qui fonctionne le mieux.

Merci a vous deux.


"Erico" <hahaha@videotron.ca> a écrit dans le message de news:
eUdOqNdYHHA.3996@TK2MSFTNGP02.phx.gbl...

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" <michdenis@hotmail.com> a écrit dans le message de news:
OB0MXZbYHHA.3928@TK2MSFTNGP02.phx.gbl...

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



"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
e27RoWbYHHA.448@TK2MSFTNGP04.phx.gbl...
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" <Erico@discussions.microsoft.com> a écrit dans le message de
news:
905910B2-5FEE-4C01-A11D-420DC3D4A5AC@microsoft.com...
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