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

graphique - histogramme, couleur de chaque barre selon valeur

3 réponses
Avatar
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@@

3 réponses

Avatar
J
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@@



Avatar
Francois L
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@@



Avatar
J
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
'-----------------------------------------------------------------