Bonjour à toutes et à tous,
Excel 2003 : Pourriez-vous m'aider ?
Comment, en VBA, colorer une ligne (col A à BE) en fonction d'un critère se
trouvant en col AN.
ex : si de an3:an500 j'ai les mots "défavorable", je souhaiterais colorer
les lignes crorrespondantes en marron (40). Puis-je programmer plusieurs
conditions dans le même code (WorksheetSelection_Change ?).
Merci pour tout
Michel69
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim c As Range
Worksheets("Feuil2").Columns("A:bz").AutoFit
If Not Intersect([be3:be500], Target) Is Nothing Then Application.EnableEvents = False For Each c In Intersect([be3:be500], Target) Select Case LCase(c.Value) Case Is = "défavorable" Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _ Interior.ColorIndex = 40
Case Is = "très défavorable" Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _ Interior.ColorIndex = 40
Case Is = "favorable", "très favorable" Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _ Interior.ColorIndex = 34
Case Else Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _ Interior.ColorIndex = xlNone End Select Next c Application.EnableEvents = True
ElseIf Not Intersect([an3:an500], Target) Is Nothing Then Application.EnableEvents = False For Each c In Intersect([an3:an500], Target) If c.Value <> "" Then _ Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _ Interior.ColorIndex = 4
Next c End If Application.EnableEvents = True
End Sub
Daniel
La procédure suivante fonctionne très bien !
Sauf que, comme c'est une procédure événementielle, celle-ci s'active seulement au moment où tu sélectionnes une cellule des plages mentionnées et selon les conditions posées, elle colore ou non la ligne. Pour ce faire, il faut que le texte y soit déjà.
Si tu désires que la couleur se modifie dès la modification du contenu du texte, tu dois retenir plutôt l'événement "Private Sub Worksheet_Change(ByVal Target As Range)" Pour ce faire, tu n'as qu'à modifier la ligne de déclaration de la procédure... le reste ne change pas.
'-------------------------------------------------------- Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim c As Range
Worksheets("Feuil2").Columns("A:bz").AutoFit
If Intersect([be3:be500], Target) Is Nothing Then Exit Sub Application.EnableEvents = False For Each c In Intersect([be3:be500], Target) Select Case LCase(c.Value) Case Is = "défavorable" Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _ Interior.ColorIndex = 40
Case Is = "très défavorable" Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _ Interior.ColorIndex = 40
Case Is = "favorable", "très favorable" Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _ Interior.ColorIndex = 34
Case Else Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _ Interior.ColorIndex = xlNone End Select Next c Application.EnableEvents = True
If Intersect([an3:an500], Target) Is Nothing Then Exit Sub Application.EnableEvents = False For Each c In Intersect([an3:an500], Target) If c.Value <> "" Then _ Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _ Interior.ColorIndex = 4
Next c Application.EnableEvents = True
End Sub '--------------------------------------------------------
Ou peut-être :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim c As Range
Worksheets("Feuil2").Columns("A:bz").AutoFit
If Not Intersect([be3:be500], Target) Is Nothing Then
Application.EnableEvents = False
For Each c In Intersect([be3:be500], Target)
Select Case LCase(c.Value)
Case Is = "défavorable"
Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _
Interior.ColorIndex = 40
Case Is = "très défavorable"
Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _
Interior.ColorIndex = 40
Case Is = "favorable", "très favorable"
Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _
Interior.ColorIndex = 34
Case Else
Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _
Interior.ColorIndex = xlNone
End Select
Next c
Application.EnableEvents = True
ElseIf Not Intersect([an3:an500], Target) Is Nothing Then
Application.EnableEvents = False
For Each c In Intersect([an3:an500], Target)
If c.Value <> "" Then _
Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _
Interior.ColorIndex = 4
Next c
End If
Application.EnableEvents = True
End Sub
Daniel
La procédure suivante fonctionne très bien !
Sauf que, comme c'est une procédure événementielle, celle-ci
s'active seulement au moment où tu sélectionnes une cellule
des plages mentionnées et selon les conditions posées, elle
colore ou non la ligne. Pour ce faire, il faut que le texte y soit
déjà.
Si tu désires que la couleur se modifie dès la modification du
contenu du texte, tu dois retenir plutôt l'événement
"Private Sub Worksheet_Change(ByVal Target As Range)"
Pour ce faire, tu n'as qu'à modifier la ligne de déclaration
de la procédure... le reste ne change pas.
'--------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim c As Range
Worksheets("Feuil2").Columns("A:bz").AutoFit
If Intersect([be3:be500], Target) Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each c In Intersect([be3:be500], Target)
Select Case LCase(c.Value)
Case Is = "défavorable"
Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _
Interior.ColorIndex = 40
Case Is = "très défavorable"
Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _
Interior.ColorIndex = 40
Case Is = "favorable", "très favorable"
Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _
Interior.ColorIndex = 34
Case Else
Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _
Interior.ColorIndex = xlNone
End Select
Next c
Application.EnableEvents = True
If Intersect([an3:an500], Target) Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each c In Intersect([an3:an500], Target)
If c.Value <> "" Then _
Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _
Interior.ColorIndex = 4
Next c
Application.EnableEvents = True
End Sub
'--------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim c As Range
Worksheets("Feuil2").Columns("A:bz").AutoFit
If Not Intersect([be3:be500], Target) Is Nothing Then Application.EnableEvents = False For Each c In Intersect([be3:be500], Target) Select Case LCase(c.Value) Case Is = "défavorable" Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _ Interior.ColorIndex = 40
Case Is = "très défavorable" Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _ Interior.ColorIndex = 40
Case Is = "favorable", "très favorable" Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _ Interior.ColorIndex = 34
Case Else Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _ Interior.ColorIndex = xlNone End Select Next c Application.EnableEvents = True
ElseIf Not Intersect([an3:an500], Target) Is Nothing Then Application.EnableEvents = False For Each c In Intersect([an3:an500], Target) If c.Value <> "" Then _ Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _ Interior.ColorIndex = 4
Next c End If Application.EnableEvents = True
End Sub
Daniel
La procédure suivante fonctionne très bien !
Sauf que, comme c'est une procédure événementielle, celle-ci s'active seulement au moment où tu sélectionnes une cellule des plages mentionnées et selon les conditions posées, elle colore ou non la ligne. Pour ce faire, il faut que le texte y soit déjà.
Si tu désires que la couleur se modifie dès la modification du contenu du texte, tu dois retenir plutôt l'événement "Private Sub Worksheet_Change(ByVal Target As Range)" Pour ce faire, tu n'as qu'à modifier la ligne de déclaration de la procédure... le reste ne change pas.
'-------------------------------------------------------- Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim c As Range
Worksheets("Feuil2").Columns("A:bz").AutoFit
If Intersect([be3:be500], Target) Is Nothing Then Exit Sub Application.EnableEvents = False For Each c In Intersect([be3:be500], Target) Select Case LCase(c.Value) Case Is = "défavorable" Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _ Interior.ColorIndex = 40
Case Is = "très défavorable" Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _ Interior.ColorIndex = 40
Case Is = "favorable", "très favorable" Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _ Interior.ColorIndex = 34
Case Else Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _ Interior.ColorIndex = xlNone End Select Next c Application.EnableEvents = True
If Intersect([an3:an500], Target) Is Nothing Then Exit Sub Application.EnableEvents = False For Each c In Intersect([an3:an500], Target) If c.Value <> "" Then _ Range(Cells(c.Row, "A"), Cells(c.Row, "BG")). _ Interior.ColorIndex = 4
Next c Application.EnableEvents = True
End Sub '--------------------------------------------------------
MichDenis
Concernant les diverses conditions, je fais confiance au demandeur je suppose que personne ne sait mieux que lui ce qu'il veut ! Je propose seulement une façon de faire ... ;-)
Concernant les diverses conditions, je fais confiance au demandeur
je suppose que personne ne sait mieux que lui ce qu'il veut !
Je propose seulement une façon de faire ... ;-)
Concernant les diverses conditions, je fais confiance au demandeur je suppose que personne ne sait mieux que lui ce qu'il veut ! Je propose seulement une façon de faire ... ;-)
Daniel.C
Oui, ton code n'est pas en cause, je soulignais que s'il veut que la macro agisse quanf il sélectionne une cellule de la plage an3:an500, il ne peut pas mettre en tête : If Intersect([be3:be500], Target) Is Nothing Then Exit Sub Daniel
Concernant les diverses conditions, je fais confiance au demandeur je suppose que personne ne sait mieux que lui ce qu'il veut ! Je propose seulement une façon de faire ... ;-)
Oui, ton code n'est pas en cause, je soulignais que s'il veut que la
macro agisse quanf il sélectionne une cellule de la plage an3:an500, il
ne peut pas mettre en tête :
If Intersect([be3:be500], Target) Is Nothing Then Exit Sub
Daniel
Concernant les diverses conditions, je fais confiance au demandeur
je suppose que personne ne sait mieux que lui ce qu'il veut !
Je propose seulement une façon de faire ... ;-)
Oui, ton code n'est pas en cause, je soulignais que s'il veut que la macro agisse quanf il sélectionne une cellule de la plage an3:an500, il ne peut pas mettre en tête : If Intersect([be3:be500], Target) Is Nothing Then Exit Sub Daniel
Concernant les diverses conditions, je fais confiance au demandeur je suppose que personne ne sait mieux que lui ce qu'il veut ! Je propose seulement une façon de faire ... ;-)
