graphique - histogramme, couleur de chaque barre selon valeur

Le
J
Bonjour à tous [XL 2000]
J'ai un graphique sous forme de simple histogramme qui se réfère à des
valeurs pouvant aller de 0,0 à 3,0. Ce graphique est situé dans la
feuille où sont les données.

SVP comment faire pour que les barres correspondant aux valeurs
*inférieures à 1 soient vertes,
*celles de 1 à <2 soient orange,
*celles >2 jusque 3 soient rouge,
de façon automatique.

Merci pour l'aide
cordialement.
J@@
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
J
Le #5012741
Re
J'ai adapté cela d'un code trouvé sais plus où (désolé), mais cela
fonctionne pour des nuages de points, comment adapter cela pour un
histogramme (des belles barres verticales)
**
Sub couleur()
Dim lngIndex As Long
On Error Resume Next
ActiveSheet.ChartObjects("Graphique 1").Activate
Application.ScreenUpdating = False
With ActiveChart.SeriesCollection(1)
For lngIndex = 1 To .Points.Count
a = Application.WorksheetFunction.Index(.Values, lngIndex)
With .Points(lngIndex)
Select Case a
Case Is < 1
.MarkerBackgroundColor = RGB(60, 200, 80)
.MarkerForegroundColor = RGB(60, 200, 80)
Case Is < 2
.MarkerBackgroundColor = RGB(210, 230, 40)
.MarkerForegroundColor = RGB(210, 230, 40)
Case Is < 3.1
.MarkerBackgroundColor = RGB(240, 80, 20)
.MarkerForegroundColor = RGB(240, 80, 20)
Case Else
.MarkerBackgroundColor = RGB(80, 160, 70)
.MarkerForegroundColor = RGB(80, 160, 70)
End Select
End With
Next
End With
Range("b2").Select
Application.ScreenUpdating = True
End Sub
***
Merci
@+
J@@

Bonjour à tous [XL 2000]
J'ai un graphique sous forme de simple histogramme qui se réfère à des
valeurs pouvant aller de 0,0 à 3,0. Ce graphique est situé dans la
feuille où sont les données.

SVP comment faire pour que les barres correspondant aux valeurs
*inférieures à 1 soient vertes,
*celles de 1 à <2 soient orange,
*celles >2 jusque 3 soient rouge,
de façon automatique.

Merci pour l'aide
cordialement.
J@@



Francois L
Le #5012731
Bonjour,

J'ai adapté ta procédure aux histogrammes, j'ai aussi modifié les
couleurs pour que le rendu sur une palette standard d'excel soit plus
proche de ce que tu souhaites et changé la manière de gérer les
conditions...

'--------------------------------------------------------------
Sub couleur()
Dim lngIndex As Long
On Error Resume Next
ActiveSheet.ChartObjects("Graphique 1").Activate
Application.ScreenUpdating = False
With ActiveChart.SeriesCollection(1)
For lngIndex = 1 To .Points.Count
a = Application.WorksheetFunction.Index(.Values, lngIndex)
With .Points(lngIndex)
If a < 1 Then
.Interior.Color = RGB(60, 200, 80)
ElseIf a < 2 Then
.Interior.Color = RGB(230, 180, 70)
ElseIf a <= 3 Then
.Interior.Color = RGB(240, 20, 20)
Else
.Interior.Color = RGB(255, 255, 255)
End If
End With
Next
End With
Range("b2").Select
Application.ScreenUpdating = True
End Sub
'-----------------------------------------------------------------

--
François L


Bonjour à tous [XL 2000]
J'ai un graphique sous forme de simple histogramme qui se réfère à des
valeurs pouvant aller de 0,0 à 3,0. Ce graphique est situé dans la
feuille où sont les données.

SVP comment faire pour que les barres correspondant aux valeurs
*inférieures à 1 soient vertes,
*celles de 1 à <2 soient orange,
*celles >2 jusque 3 soient rouge,
de façon automatique.

Merci pour l'aide
cordialement.
J@@



J
Le #5012691
Bonjour François
super
cela marche parfaitement
merci beaucoup :-)
@+
J@@

Bonjour,

J'ai adapté ta procédure aux histogrammes, j'ai aussi modifié les
couleurs pour que le rendu sur une palette standard d'excel soit plus
proche de ce que tu souhaites et changé la manière de gérer les
conditions...

'--------------------------------------------------------------
Sub couleur()
Dim lngIndex As Long
On Error Resume Next
ActiveSheet.ChartObjects("Graphique 1").Activate
Application.ScreenUpdating = False
With ActiveChart.SeriesCollection(1)
For lngIndex = 1 To .Points.Count
a = Application.WorksheetFunction.Index(.Values, lngIndex)
With .Points(lngIndex)
If a < 1 Then
.Interior.Color = RGB(60, 200, 80)
ElseIf a < 2 Then
.Interior.Color = RGB(230, 180, 70)
ElseIf a <= 3 Then
.Interior.Color = RGB(240, 20, 20)
Else
.Interior.Color = RGB(255, 255, 255)
End If
End With
Next
End With
Range("b2").Select
Application.ScreenUpdating = True
End Sub
'-----------------------------------------------------------------



Publicité
Poster une réponse
Anonyme