Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Mise en forme conditionnelle d'un Graphique (2)

5 réponses
Avatar
If
Encore merci à toi lSteph.

Juste une question vu que je coince.
Est-il possible d'utiliser cette procédure pour plusieurs graphiques sur
la même feuille.
Ou faut-il passer par une procédure dans un module ?

Voir ici pour voir ce que je veux faire.
http://cjoint.com/?fAtcnLhuRp


Déjà merci pour l'aide

Yves





Bonsoir,
Pour adapter il faut distinguer graphique séries en lignes (ton exemple)ou
en colonnes(celui de01):

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B2:f5"), Target) Is Nothing Then
Dim I As Integer, J as Integer

With ChartObjects(1).Chart
For j = 1 To .SeriesCollection.Count
For I = 1 To .SeriesCollection(j).Points.Count
If Cells(j + 1, I + 1) > 0.6 Then
.SeriesCollection(j).Points(I).Interior.Color = vbRed
Else
.SeriesCollection(j).Points(I).Interior.Color = vbGreen
End If
Next
Next
End With
End If
End Sub





'lSteph
"If" <_yves.duchene@skynet.be> a écrit dans le message de news:
447622da$0$23248$ba620e4c@news.skynet.be...
> > Bonsoir à tous
> >
> > En prenant l'idée que je peux trouver ici :
> >
http://forum.telecharger.01net.com/microhebdo/logiciels/bureautique/couleur_graphique_excel-327499/messages-1.html
> >
> > J'aimerais obtenir un graphique avec des barres colorisées avec
condition.
> > Par exemple, si la valeur est supérieure à 60% la barre serait rouge.
> >
> > CA Un Deux Trois Quatre Cinq
> > Jan. 45% 88% 60% 40% 50%
> > Fév. 40% 44% 10% 44% 44%
> > Mar. 28% 77% 44% 79% 40%
> > Avr. 37% 44% 55% 44% 44%
> >
> > Fichier exemple : http://cjoint.com/?fzxFgRiqFR
> >
> >
> > Procédure se trouvant sur la page renseignée ci-dessus.
> >
> > Private Sub Worksheet_Change(ByVal Target As Range)
> > If Not Intersect(Range("B5:C8"), Target) Is Nothing Then
> > Dim I As Integer
> > With ChartObjects(1).Chart.SeriesCollection(1)
> > For I = 1 To .Points.Count
> > If Cells(I + 4, 2) < Cells(I + 4, 3) Then
> > .Points(I).Interior.Color = vbRed
> > Else
> > .Points(I).Interior.Color = vbGreen
> > End If
> > Next
> > End With
> > End If
> > End Sub
> >
> >
> >
> > En avance merci pour vos tuyaux.
> >
> >
> > Yves

5 réponses

Avatar
Fredo P
Quelque chose de ce genre après avoir fait la copie du graphe original sur
la même feuille.
For Gr=1 to 2
With ChartObjects(Gr).Chart
For J = 1 To .SeriesCollection.Count
For I = 1 To .SeriesCollection(J).Points.Count
If Cells(J + 1, I + 1) < 0.6 Then
.SeriesCollection(J).Points(I).Interior.Color = vbRed
ElseIf Cells(J + 1, I + 1) >= 0.6 And Cells(J + 1, I + 1) < 0.8 Then
.SeriesCollection(J).Points(I).Interior.Color = vbYellow
Else
.SeriesCollection(J).Points(I).Interior.Color = vbGreen
End If
Next
Next
End With
next
"If" a écrit dans le message de news:
44773559$0$31758$
Encore merci à toi lSteph.

Juste une question vu que je coince.
Est-il possible d'utiliser cette procédure pour plusieurs graphiques sur
la même feuille.
Ou faut-il passer par une procédure dans un module ?

Voir ici pour voir ce que je veux faire.
http://cjoint.com/?fAtcnLhuRp


Déjà merci pour l'aide

Yves





Bonsoir,
Pour adapter il faut distinguer graphique séries en lignes (ton exemple)ou
en colonnes(celui de01):

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B2:f5"), Target) Is Nothing Then
Dim I As Integer, J as Integer

With ChartObjects(1).Chart
For j = 1 To .SeriesCollection.Count
For I = 1 To .SeriesCollection(j).Points.Count
If Cells(j + 1, I + 1) > 0.6 Then
.SeriesCollection(j).Points(I).Interior.Color = vbRed
Else
.SeriesCollection(j).Points(I).Interior.Color = vbGreen
End If
Next
Next
End With
End If
End Sub





'lSteph
"If" a écrit dans le message de news:
447622da$0$23248$
Bonsoir à tous

En prenant l'idée que je peux trouver ici :




http://forum.telecharger.01net.com/microhebdo/logiciels/bureautique/couleur_

graphique_excel-327499/messages-1.html

J'aimerais obtenir un graphique avec des barres colorisées avec
condition.


Par exemple, si la valeur est supérieure à 60% la barre serait rouge.

CA Un Deux Trois Quatre Cinq
Jan. 45% 88% 60% 40% 50%
Fév. 40% 44% 10% 44% 44%
Mar. 28% 77% 44% 79% 40%
Avr. 37% 44% 55% 44% 44%

Fichier exemple : http://cjoint.com/?fzxFgRiqFR


Procédure se trouvant sur la page renseignée ci-dessus.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B5:C8"), Target) Is Nothing Then
Dim I As Integer
With ChartObjects(1).Chart.SeriesCollection(1)
For I = 1 To .Points.Count
If Cells(I + 4, 2) < Cells(I + 4, 3) Then
.Points(I).Interior.Color = vbRed
Else
.Points(I).Interior.Color = vbGreen
End If
Next
End With
End If
End Sub



En avance merci pour vos tuyaux.


Yves








Avatar
lSteph
Bonsoir,
Provisoirement pour tes deux graphiques,(car mieux serait de repérer les
plages sources des graphiques et selon leur nombre ...)
mais ceci ira pour l'heure:
'''''***********
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Union(Range("B2:f5"), Range("b22:f25")), Target) Is Nothing
Then
Dim I As Integer, J As Integer

With ChartObjects(1).Chart
For J = 1 To .SeriesCollection.Count
For I = 1 To .SeriesCollection(J).Points.Count
If Cells(J + 1, I + 1) < 0.6 Then
.SeriesCollection(J).Points(I).Interior.Color = vbRed
ElseIf Cells(J + 1, I + 1) >= 0.6 And Cells(J + 1, I + 1) < 0.8 Then
.SeriesCollection(J).Points(I).Interior.Color = vbYellow
Else
.SeriesCollection(J).Points(I).Interior.Color = vbGreen
End If
Next
Next
End With
With ChartObjects(2).Chart
For J = 1 To .SeriesCollection.Count
For I = 1 To .SeriesCollection(J).Points.Count
If Cells(J + 21, I + 1) < 0.6 Then
.SeriesCollection(J).Points(I).Interior.Color = vbRed
ElseIf Cells(J + 21, I + 1) >= 0.6 And Cells(J + 21, I + 1) < 0.8 Then
.SeriesCollection(J).Points(I).Interior.Color = vbYellow
Else
.SeriesCollection(J).Points(I).Interior.Color = vbGreen
End If
Next
Next
End With
End If
End Sub
'''''*****

'lSteph


"If" a écrit dans le message de news:
44773559$0$31758$
Encore merci à toi lSteph.

Juste une question vu que je coince.
Est-il possible d'utiliser cette procédure pour plusieurs graphiques sur
la même feuille.
Ou faut-il passer par une procédure dans un module ?

Voir ici pour voir ce que je veux faire.
http://cjoint.com/?fAtcnLhuRp


Déjà merci pour l'aide

Yves





Bonsoir,
Pour adapter il faut distinguer graphique séries en lignes (ton exemple)ou
en colonnes(celui de01):

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B2:f5"), Target) Is Nothing Then
Dim I As Integer, J as Integer

With ChartObjects(1).Chart
For j = 1 To .SeriesCollection.Count
For I = 1 To .SeriesCollection(j).Points.Count
If Cells(j + 1, I + 1) > 0.6 Then
.SeriesCollection(j).Points(I).Interior.Color = vbRed
Else
.SeriesCollection(j).Points(I).Interior.Color = vbGreen
End If
Next
Next
End With
End If
End Sub





'lSteph
"If" a écrit dans le message de news:
447622da$0$23248$
Bonsoir à tous

En prenant l'idée que je peux trouver ici :

http://forum.telecharger.01net.com/microhebdo/logiciels/bureautique/couleur_graphique_excel-327499/messages-1.html



J'aimerais obtenir un graphique avec des barres colorisées avec
condition.


Par exemple, si la valeur est supérieure à 60% la barre serait rouge.

CA Un Deux Trois Quatre Cinq
Jan. 45% 88% 60% 40% 50%
Fév. 40% 44% 10% 44% 44%
Mar. 28% 77% 44% 79% 40%
Avr. 37% 44% 55% 44% 44%

Fichier exemple : http://cjoint.com/?fzxFgRiqFR


Procédure se trouvant sur la page renseignée ci-dessus.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B5:C8"), Target) Is Nothing Then
Dim I As Integer
With ChartObjects(1).Chart.SeriesCollection(1)
For I = 1 To .Points.Count
If Cells(I + 4, 2) < Cells(I + 4, 3) Then
.Points(I).Interior.Color = vbRed
Else
.Points(I).Interior.Color = vbGreen
End If
Next
End With
End If
End Sub



En avance merci pour vos tuyaux.


Yves








Avatar
If
Merci pour ton aide.


----- Original Message -----
From Fredo P
, Sent 26/05/2006 21:30:
Quelque chose de ce genre après avoir fait la copie du graphe original sur
la même feuille.
For Gr=1 to 2
With ChartObjects(Gr).Chart
For J = 1 To .SeriesCollection.Count
For I = 1 To .SeriesCollection(J).Points.Count
If Cells(J + 1, I + 1) < 0.6 Then
.SeriesCollection(J).Points(I).Interior.Color = vbRed
ElseIf Cells(J + 1, I + 1) >= 0.6 And Cells(J + 1, I + 1) < 0.8 Then
.SeriesCollection(J).Points(I).Interior.Color = vbYellow
Else
.SeriesCollection(J).Points(I).Interior.Color = vbGreen
End If
Next
Next
End With
next
"If" a écrit dans le message de news:
44773559$0$31758$
Encore merci à toi lSteph.

Juste une question vu que je coince.
Est-il possible d'utiliser cette procédure pour plusieurs graphiques sur
la même feuille.
Ou faut-il passer par une procédure dans un module ?

Voir ici pour voir ce que je veux faire.
http://cjoint.com/?fAtcnLhuRp


Déjà merci pour l'aide

Yves





Bonsoir,
Pour adapter il faut distinguer graphique séries en lignes (ton exemple)ou
en colonnes(celui de01):

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B2:f5"), Target) Is Nothing Then
Dim I As Integer, J as Integer

With ChartObjects(1).Chart
For j = 1 To .SeriesCollection.Count
For I = 1 To .SeriesCollection(j).Points.Count
If Cells(j + 1, I + 1) > 0.6 Then
.SeriesCollection(j).Points(I).Interior.Color = vbRed
Else
.SeriesCollection(j).Points(I).Interior.Color = vbGreen
End If
Next
Next
End With
End If
End Sub





'lSteph
"If" a écrit dans le message de news:
447622da$0$23248$
Bonsoir à tous

En prenant l'idée que je peux trouver ici :




http://forum.telecharger.01net.com/microhebdo/logiciels/bureautique/couleur_

graphique_excel-327499/messages-1.html

J'aimerais obtenir un graphique avec des barres colorisées avec
condition.


Par exemple, si la valeur est supérieure à 60% la barre serait rouge.

CA Un Deux Trois Quatre Cinq
Jan. 45% 88% 60% 40% 50%
Fév. 40% 44% 10% 44% 44%
Mar. 28% 77% 44% 79% 40%
Avr. 37% 44% 55% 44% 44%

Fichier exemple : http://cjoint.com/?fzxFgRiqFR


Procédure se trouvant sur la page renseignée ci-dessus.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B5:C8"), Target) Is Nothing Then
Dim I As Integer
With ChartObjects(1).Chart.SeriesCollection(1)
For I = 1 To .Points.Count
If Cells(I + 4, 2) < Cells(I + 4, 3) Then
.Points(I).Interior.Color = vbRed
Else
.Points(I).Interior.Color = vbGreen
End If
Next
End With
End If
End Sub



En avance merci pour vos tuyaux.


Yves












Avatar
If
Bonsoir lSteph,

C'est nickel pour moi.
Avec cette procédure, j'ai ajouté un troisième graphique et c'est bon.
Mais je dois aller jusqu'à 7 graphiques du même type et donc j'ai peur
d'avoir un problème.

Y aurait-il une procédure plus correct dont tu fais allusion dans ta
réponse ?

En avance merci
Yves




----- Original Message -----
From lSteph
, Sent 26/05/2006 22:55:
Bonsoir,
Provisoirement pour tes deux graphiques,(car mieux serait de repérer les
plages sources des graphiques et selon leur nombre ...)
mais ceci ira pour l'heure:
'''''***********
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Union(Range("B2:f5"), Range("b22:f25")), Target) Is Nothing
Then
Dim I As Integer, J As Integer

With ChartObjects(1).Chart
For J = 1 To .SeriesCollection.Count
For I = 1 To .SeriesCollection(J).Points.Count
If Cells(J + 1, I + 1) < 0.6 Then
.SeriesCollection(J).Points(I).Interior.Color = vbRed
ElseIf Cells(J + 1, I + 1) >= 0.6 And Cells(J + 1, I + 1) < 0.8 Then
.SeriesCollection(J).Points(I).Interior.Color = vbYellow
Else
.SeriesCollection(J).Points(I).Interior.Color = vbGreen
End If
Next
Next
End With
With ChartObjects(2).Chart
For J = 1 To .SeriesCollection.Count
For I = 1 To .SeriesCollection(J).Points.Count
If Cells(J + 21, I + 1) < 0.6 Then
.SeriesCollection(J).Points(I).Interior.Color = vbRed
ElseIf Cells(J + 21, I + 1) >= 0.6 And Cells(J + 21, I + 1) < 0.8 Then
.SeriesCollection(J).Points(I).Interior.Color = vbYellow
Else
.SeriesCollection(J).Points(I).Interior.Color = vbGreen
End If
Next
Next
End With
End If
End Sub
'''''*****

'lSteph


"If" a écrit dans le message de news:
44773559$0$31758$
Encore merci à toi lSteph.

Juste une question vu que je coince.
Est-il possible d'utiliser cette procédure pour plusieurs graphiques sur
la même feuille.
Ou faut-il passer par une procédure dans un module ?

Voir ici pour voir ce que je veux faire.
http://cjoint.com/?fAtcnLhuRp


Déjà merci pour l'aide

Yves





Bonsoir,
Pour adapter il faut distinguer graphique séries en lignes (ton exemple)ou
en colonnes(celui de01):

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B2:f5"), Target) Is Nothing Then
Dim I As Integer, J as Integer

With ChartObjects(1).Chart
For j = 1 To .SeriesCollection.Count
For I = 1 To .SeriesCollection(j).Points.Count
If Cells(j + 1, I + 1) > 0.6 Then
.SeriesCollection(j).Points(I).Interior.Color = vbRed
Else
.SeriesCollection(j).Points(I).Interior.Color = vbGreen
End If
Next
Next
End With
End If
End Sub





'lSteph
"If" a écrit dans le message de news:
447622da$0$23248$
Bonsoir à tous

En prenant l'idée que je peux trouver ici :

http://forum.telecharger.01net.com/microhebdo/logiciels/bureautique/couleur_graphique_excel-327499/messages-1.html


J'aimerais obtenir un graphique avec des barres colorisées avec
condition.


Par exemple, si la valeur est supérieure à 60% la barre serait rouge.

CA Un Deux Trois Quatre Cinq
Jan. 45% 88% 60% 40% 50%
Fév. 40% 44% 10% 44% 44%
Mar. 28% 77% 44% 79% 40%
Avr. 37% 44% 55% 44% 44%

Fichier exemple : http://cjoint.com/?fzxFgRiqFR


Procédure se trouvant sur la page renseignée ci-dessus.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B5:C8"), Target) Is Nothing Then
Dim I As Integer
With ChartObjects(1).Chart.SeriesCollection(1)
For I = 1 To .Points.Count
If Cells(I + 4, 2) < Cells(I + 4, 3) Then
.Points(I).Interior.Color = vbRed
Else
.Points(I).Interior.Color = vbGreen
End If
Next
End With
End If
End Sub



En avance merci pour vos tuyaux.


Yves











Avatar
lSteph
Bonsoir Yves,

http://cjoint.com/?fCuGzYPj55

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zchars As New Collection

For k = 1 To ChartObjects.Count
Zchars.Add SourceChar(ChartObjects(k).Name), CStr(k)

If Not Intersect(Range(Zchars(k)), Target) Is Nothing Then
Dim I As Integer, J As Integer

With ChartObjects(k).Chart
For J = 1 To .SeriesCollection.Count
For I = 1 To .SeriesCollection(J).Points.Count
If Range(Zchars(k)).Cells(J, I) < 0.6 Then
.SeriesCollection(J).Points(I).Interior.Color = vbRed
ElseIf Range(Zchars(k)).Cells(J, I) >= 0.6 And Range(Zchars(k)).Cells(J, I)
< 0.8 Then
.SeriesCollection(J).Points(I).Interior.Color = vbYellow
Else
.SeriesCollection(J).Points(I).Interior.Color = vbGreen
End If
Next
Next
End With

End If
Next k
End Sub
Function SourceChar(Mygr As String) As String
With ActiveSheet.ChartObjects(Mygr).Chart
SourceChar = ""
For I = 1 To .SeriesCollection.Count
With .SeriesCollection(I)
If Not Len(SourceChar) > 0 Then
SourceChar = Mid(.Formula, 9, Len(.Formula) - 11)
Else
SourceChar = Union(Range(SourceChar), _
Range(Mid(.Formula, 9, Len(.Formula) - 11))).Address
End If
End With
Next
End With
With Range(SourceChar).CurrentRegion
SourceChar = Range(.Rows(2).Cells(2), .Cells(.Cells.Count)).Address
End With
End Function

'lSteph

"If" a écrit dans le message de news:
447787a1$0$32429$
Bonsoir lSteph,

C'est nickel pour moi.
Avec cette procédure, j'ai ajouté un troisième graphique et c'est bon.
Mais je dois aller jusqu'à 7 graphiques du même type et donc j'ai peur
d'avoir un problème.

Y aurait-il une procédure plus correct dont tu fais allusion dans ta
réponse ?

En avance merci
Yves




----- Original Message -----
From lSteph
, Sent 26/05/2006 22:55:
Bonsoir,
Provisoirement pour tes deux graphiques,(car mieux serait de repérer les
plages sources des graphiques et selon leur nombre ...)
mais ceci ira pour l'heure:
'''''***********
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Union(Range("B2:f5"), Range("b22:f25")), Target) Is
Nothing Then
Dim I As Integer, J As Integer

With ChartObjects(1).Chart
For J = 1 To .SeriesCollection.Count
For I = 1 To .SeriesCollection(J).Points.Count
If Cells(J + 1, I + 1) < 0.6 Then
.SeriesCollection(J).Points(I).Interior.Color = vbRed
ElseIf Cells(J + 1, I + 1) >= 0.6 And Cells(J + 1, I + 1) < 0.8 Then
.SeriesCollection(J).Points(I).Interior.Color = vbYellow
Else
.SeriesCollection(J).Points(I).Interior.Color = vbGreen
End If
Next
Next
End With
With ChartObjects(2).Chart
For J = 1 To .SeriesCollection.Count
For I = 1 To .SeriesCollection(J).Points.Count
If Cells(J + 21, I + 1) < 0.6 Then
.SeriesCollection(J).Points(I).Interior.Color = vbRed
ElseIf Cells(J + 21, I + 1) >= 0.6 And Cells(J + 21, I + 1) < 0.8 Then
.SeriesCollection(J).Points(I).Interior.Color = vbYellow
Else
.SeriesCollection(J).Points(I).Interior.Color = vbGreen
End If
Next
Next
End With
End If
End Sub
'''''*****

'lSteph


"If" a écrit dans le message de news:
44773559$0$31758$
Encore merci à toi lSteph.

Juste une question vu que je coince.
Est-il possible d'utiliser cette procédure pour plusieurs graphiques sur
la même feuille.
Ou faut-il passer par une procédure dans un module ?

Voir ici pour voir ce que je veux faire.
http://cjoint.com/?fAtcnLhuRp


Déjà merci pour l'aide

Yves





Bonsoir,
Pour adapter il faut distinguer graphique séries en lignes (ton
exemple)ou
en colonnes(celui de01):

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B2:f5"), Target) Is Nothing Then
Dim I As Integer, J as Integer

With ChartObjects(1).Chart
For j = 1 To .SeriesCollection.Count
For I = 1 To .SeriesCollection(j).Points.Count
If Cells(j + 1, I + 1) > 0.6 Then
.SeriesCollection(j).Points(I).Interior.Color = vbRed
Else
.SeriesCollection(j).Points(I).Interior.Color = vbGreen
End If
Next
Next
End With
End If
End Sub





'lSteph
"If" a écrit dans le message de news:
447622da$0$23248$
Bonsoir à tous

En prenant l'idée que je peux trouver ici :

http://forum.telecharger.01net.com/microhebdo/logiciels/bureautique/couleur_graphique_excel-327499/messages-1.html


J'aimerais obtenir un graphique avec des barres colorisées avec
condition.


Par exemple, si la valeur est supérieure à 60% la barre serait rouge.

CA Un Deux Trois Quatre Cinq
Jan. 45% 88% 60% 40% 50%
Fév. 40% 44% 10% 44% 44%
Mar. 28% 77% 44% 79% 40%
Avr. 37% 44% 55% 44% 44%

Fichier exemple : http://cjoint.com/?fzxFgRiqFR


Procédure se trouvant sur la page renseignée ci-dessus.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B5:C8"), Target) Is Nothing Then
Dim I As Integer
With ChartObjects(1).Chart.SeriesCollection(1)
For I = 1 To .Points.Count
If Cells(I + 4, 2) < Cells(I + 4, 3) Then
.Points(I).Interior.Color = vbRed
Else
.Points(I).Interior.Color = vbGreen
End If
Next
End With
End If
End Sub



En avance merci pour vos tuyaux.


Yves