couleur graphe VB

[Heriss]

Bonjour le forum,

Je cherche à affecter une couleur à des secteurs d'un diagramme en fonction de la valeur de l'étiquette.

Dans un premier temps je veux que la macro utilise la plage de cellules sélectionnée pour construire mon graphe (j'ai déjà un plantage pour récuppérer l'adresse de la plage mon code VB -si on peut appeler cela un code vu le nombre d'erreurs- ).

Ensuite je souhaiterai que le code modifie les couleurs du graphe selon un tableau de références couleurs. (là je n'ose même plus dire que c'est du code VB tant il y a de manques)


Merci d'avance pour votre aide et bonne fin de journée
Heriss

Message édité par: heriss, à: 25/02/2005 10:54

 

[heriss]

Re-bonjour le forum,

Voici le fichier zippé... sorry!!!

Heriss [file name=Set_Color_to_chart.zip size=9654]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Set_Color_to_chart.zip[/file]

 

[MichelXld]

bonsoir Heriss

j'espere que cet exemple répondra à ta demande
( macro à placer directement dans ton classeur )


Sub creationGraphique()
Dim i As Byte

Charts.Add ' ajout graphique
With ActiveChart
.ChartType = xl3DPie 'secteur 3D
.SetSourceData Source:=Sheets('Données').Range('C5:C7'), PlotBy:=xlColumns
.Location Where:=xlLocationAsObject, Name:='Données' 'emplacement du nouveau graphique
End With

For i = 1 To 3 'boucle pour attribution couleurs
ActiveChart.SeriesCollection(1).Points(i).Interior.ColorIndex = _
Sheets('Index couleur').Cells(i + 1, 2)
Next i

End Sub


bon week end
MichelXld

 

[heriss]

Bonjour Miche Xld,
Bonjour le forum,

Merci beaucoup pour le code qui va m'aider à avancer sur mon problème. En revanche cela ne réponds pas tout à fait à ce que je souhaite. Je n'avais pas été clair (car comme je vis en continu avec ça je ne m'imagine pas que d'autres ne puissent pas être dans le même trip) et ce que je cherche c'est:

- pour la première partie du code, pouvoir obtenir l'adresse de la sélection de manière à pouvoir faire varier la plage de donnée (j'avais initialement saisi en dur l'adresse B5:C7 mais cela pose un problème si le nombre de données varie)

- pour la deuxième partie ta ligne de code il faut que la couleur soit basée sur la valeur de l'étiquette et non pas sur non numéro. En clair, prendre la valeur 'France' (qui selon les graphes ne sera pas forcément en première place) et faire une recherche dans la table de référence pour trouver la couleur correspondante.

Voila pour les précisions.
Merci beaucoup de ton aide et si tu veux continuer ne t'en prive pas
;-)

Bon week-end,
Heriss

 

[MichelXld]

bonjour Heriss

tu peux tester cette adapatation

Option Compare Text
Sub creationGraphique_V02()
Dim i As Byte
Dim j As Integer, k As Integer
Dim Cell As Range

On Error Resume Next
ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Delete
On Error GoTo 0

'derniere ligne non vide dans la colonne A de la feuille 'Index couleur'
k = Sheets('Données').Range('C65536').End(xlUp).Row

Charts.Add ' ajout graphique
With ActiveChart
.ChartType = xl3DPie 'secteur 3D
.SetSourceData Source:=Sheets('Données').Range('C5:C' & k), PlotBy:=xlColumns
.Location Where:=xlLocationAsObject, Name:='Données' 'emplacement du nouveau graphique
End With

'nommer le nouveau graphique
ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Name = 'mongraph'

'derniere ligne non vide dans la colonne A de la feuille 'Index couleur'
j = Sheets('Index couleur').Range('A65536').End(xlUp).Row

For i = 1 To ActiveChart.SeriesCollection(1).Points.Count

For Each Cell In Sheets('Index couleur').Range('A2:A' & j)
'verifie que l'etiquette correspond au nom de l'index couleur
If Sheets('Données').Cells(4 + i, 2) = Cell Then
ActiveChart.SeriesCollection(1).Points(i).Interior.ColorIndex = Cell.Offset(0, 1)
Exit For
End If

Next Cell

Next i
End Sub

bon week end
MichelXld

 

[heriss]

Bonjour Michel Xld,
Bonjour le Forum,

Une seule chose à dire 'Superbe' et surtout un grand merci pour ton aide.

Je pense que cette manip' d'affectation de couleurs en fonction de l'étiquette est susceptible d'intéresser d'autres personnes et que peut être que cela vaut le coup que tu la soumettes dans la section téléchargement.

Quant à moi, je vais essayer de digérer ton code.
Encore merci et bon week-end.

Heriss