Mise en forme conditionnelle défaillante
Bonjour à tous,
Dans le fichier joint (Help SLI.xlsm) j'ai besoin d'utiliser les mises en forme conditionnelles et j'ai quelques soucis. Je m'explique.
J'ai mis dans la Feuil1 (Base) un code : Private Sub Worksheet_Change(ByVal Target As Range) qui marche partiellement.
1 - Je clique sur Add New, cela crée une ligne avec par défaut la case Status = On Going. Pour ce Status On Going je souhaite un remplissage sans couleur, ce qui fonctionne bien actuellement.
Puis lorsque je change le Status en Canceled j'ai bien un remplissage Rouge, et si c'est Done = vert. Ca c'est ok. Par contre si je resélectionne On Going alors le remplissage reste celui du précédent Status, c'est à dire vert ou rouge au lieu de sans remplissage.
2 - Ensuite, je souhaite que tant que la case Pilot est vide, le remplissage se fasse en rouge. Pour l'instant j'ai l'inverse et si je revide la case alors la couleur de remplissage ne change pas.
3 - Enfin je souhaite que pour la colonne Due Date, le remplissage soit rouge si pas de date ou date dépassée. Là je n'ai encore rien codé vu mes soucis ci-dessus.
Merci de vos lumières, je sèche complètement.
Bonnes fêtes.
Cordialement
Thierry
Bonjour
Fonction normal puisque vous avez mis les conditions en cascades "If... end iF" puis, "If... end iF" et un troisième "If... end iF"
alors qu'il faudrait: "If... " puis, "elseIf..." et encore "elseIf... end iF"
ce qui donne:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim col_status As Range
Dim col_dates As Range
Dim col_pilot As Range
'vérifier changement dans colonne Status
Set col_status = ActiveSheet.Range("i6", ActiveSheet.Range("i" & ActiveSheet.Rows.Count).End(xlUp))
If Not Application.Intersect(col_status, Target) Is Nothing Then
If Target.Value = "Done" Then
Target.Interior.ColorIndex = 4
ElseIf Target.Value = "Canceled" Then
Target.Interior.ColorIndex = 3
ElseIf Target.Value = "On Going" Then
Target.Interior.ColorIndex = 2
End If
End If
'vérifier nom dans colonne Pilot
Set col_pilot = ActiveSheet.Range("f6", ActiveSheet.Range("f" & ActiveSheet.Rows.Count).End(xlUp))
If Not Application.Intersect(col_pilot, Target) Is Nothing Then Target.Interior.ColorIndex = 3
End SubCdlt
Bonjour,
Merci pour la réactivité.
Le code marche très bien pour la colonne Status mais pas pour la colonne Pilot. Je rejoins la version 2 du fichier.
A la création d'une nouvelle ligne la case Pilot est non colorée en rouge, si je mets du texte elle se colore en rouge et si j'enlève le texte elle reste colorée en rouge.
Avez-vous une idée ?
Merci par avance
Cordialement
Thierry
A vrai dire, je ne me suis pas occupé de la colonne "Pilot", sinon voici:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim DerLig_Status As Long, DerLig_Pilot As Long
On Error Resume Next
'vérifier changement dans colonne Status
DerLig_Status = Range("I" & Rows.Count).End(xlUp).Row
If Not Application.Intersect(Target, Range("I6:I" & DerLig_Status)) Is Nothing Then
If Target.Value = "Done" Then
Target.Interior.ColorIndex = 4
ElseIf Target.Value = "Canceled" Then
Target.Interior.ColorIndex = 3
ElseIf Target.Value = "On Going" Then
Target.Interior.ColorIndex = 2
End If
End If
'vérifier nom dans colonne Pilot
DerLig_Pilot = Range("F" & Rows.Count).End(xlUp).Row
If Not Application.Intersect(Target, Range("F6:F" & DerLig_Pilot)) Is Nothing Then
Target.Interior.ColorIndex = 3
Else
Target.Interior.ColorIndex = xlNone
End If
End SubCdlt
Merci de nouveau.
Cela ne marche pas. SI je copie le code tel que alors la MFC de la colonne Status ne fonctionne plus. Si je mets en commentaire les lignes
Else
et
'Target.Interior.ColorIndex = xlNone
alors la MFC colonne Status refonctionne. Comme si le code Target.Interior.ColorIndex = xlNone prenait la main sur l'ensemble de la feuille
Merci de votre support
Cordialement
Thierry
Ceci:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim DerLig_Status As Long, DerLig_Pilot As Long
On Error GoTo Sortie
Application.EnableEvents = False
'vérifier changement dans colonne Status
DerLig_Status = Range("I" & Rows.Count).End(xlUp).Row + 1
If Not Application.Intersect(Target, Range("I6:I" & DerLig_Status)) Is Nothing Then
If Target.Value = "Done" Then
Target.Interior.ColorIndex = 4
ElseIf Target.Value = "Canceled" Then
Target.Interior.ColorIndex = 3
ElseIf Target.Value = "On Going" Then
Target.Interior.ColorIndex = 2
End If
GoTo Sortie
End If
'vérifier nom dans colonne Pilot
DerLig_Pilot = Range("F" & Rows.Count).End(xlUp).Row + 1
If Not Application.Intersect(Target, Range("F6:F" & DerLig_Pilot)) Is Nothing Then
Target.Interior.ColorIndex = 3
Else
Target.Interior.ColorIndex = xlNone
End If
Sortie:
Application.EnableEvents = True
End SubCdlt
Re,
Maintenant le code pour la colonne Status fonctionne parfaitement mais rien à faire pour la colonne Pilot, cela ne fonctionne pas
Cordialement
Thierry
Correctif
Private Sub Worksheet_Change(ByVal Target As Range)
Dim DerLig As Long
On Error GoTo Sortie
Application.EnableEvents = False
'vérifier changement dans colonne Status
DerLig = Range("B" & Rows.Count).End(xlUp).Row + 1
If DerLig < 6 Then DerLig = 6
If Not Application.Intersect(Target, Range("I6:I" & DerLig)) Is Nothing Then
If Target.Value = "Done" Then
Target.Interior.ColorIndex = 4
ElseIf Target.Value = "Canceled" Then
Target.Interior.ColorIndex = 3
ElseIf Target.Value = "On Going" Then
Target.Interior.ColorIndex = 2
End If
GoTo Sortie
End If
'vérifier nom dans colonne Pilot
If Not Application.Intersect(Target, Range("F6:F" & DerLig)) Is Nothing Then
If Target.Value <> "" Then
Target.Interior.ColorIndex = 3
Else
Target.Interior.ColorIndex = xlNone
End If
End If
Sortie:
Application.EnableEvents = True
End SubRe,
Tout marche parfaitement
Merci beaucoup pour l'aide
Cordialement
Thierry