Bonjour à tous.

Je suis à la recherche (certainement par VBA) d'un moyen d'automatiser les couleurs des séries d'un graphique de type histogramme en fonction des libellés des étiquettes des séries.

Le document est téléchargeable avec ce lien :

http://cjoint.com/?DJqpPpBsWlS

Les étiquettes peuvent prendre 4 valeurs :

- "Bon niveau" et en ce cas la couleur de la série serait bleu turquoise (RGB : 102 204 255)

- "Niveau moyen" et en ce cas la couleur de la série serait lavande (RGB : 255 153 255)

- "Passable" et en ce cas la couleur de la série serait vert clair (RGB : 204 255 153)

- "Autres cas" et en ce cas la couleur de la série serait orange (RGB : 255 192 0)

A noter que les étiquettes ne sont pas forcément au nombre de 4 ; le "niveau moyen" peut être absent de l'étude par exemple.

Je génère le graphique par la macro suivante, en sélectionnant la source (ici cellules B4:T9) à l'aide d'une Inputbox

Sub generegraph()
'

Dim Var As range, i As Integer, NomZone As String
On Error Resume Next
Set Var = Application.InputBox("Sélectionner la source du graphique à partir de la cellule B4", _
"Sélection de zone ", Default:="", Type:=8)
On Error GoTo 0
If Not Var Is Nothing Then
'MsgBox Var.Address qui correspond aux références des cellules sélectionnées
Var.Select
Else
Exit Sub
End If

Dim maplage As range
Set maplage = Selection


'

'
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Activesheet.Shapes.AddChart.Select
ActiveChart.SeriesCollection(1).ChartType = xl3DColumnStacked
ActiveChart.Parent.Name = "mongraph"

ActiveChart.SetSourceData Source:=maplage
Activesheet.Shapes("mongraph").ScaleWidth 1.5989584427, msoFalse, _
msoScaleFromTopLeft
Activesheet.Shapes("mongraph").ScaleHeight 1.4861111111, msoFalse, _
msoScaleFromTopLeft
Activesheet.Shapes("mongraph").ScaleWidth 1.2657980274, msoFalse, _
msoScaleFromTopLeft
Activesheet.Shapes("mongraph").ScaleHeight 1.1565420561, msoFalse, _
msoScaleFromTopLeft


Activesheet.ChartObjects("mongraph").Activate
ActiveChart.Axes(xlValue).MajorGridlines.Select
ActiveChart.ChartArea.Format.ThreeD.Perspective = False


Mavariable = Var.Address
'MsgBox mavariable
range(Mavariable).SpecialCells(xlCellTypeConstants, 1).Select
For Each Cellule In Selection
If Cellule.Value = 0 Then Cellule.Value = ""
Next

Activesheet.ChartObjects("mongraph").Activate

For num = 1 To ActiveChart.SeriesCollection.Count

ActiveChart.ChartArea.Select
ActiveChart.SeriesCollection(num).Select
ActiveChart.SetElement (msoElementDataLabelShow)
Next



Activesheet.ChartObjects("mongraph").Activate
ActiveChart.Legend.Select
ActiveChart.Legend.Select
Selection.Position = xlBottom



End Sub

Merci beaucoup pour votre aide