couleur fixe de courbes

[toubib]

bonjour à tous,

je souhaiterais pouvoir attribuer à des courbes d'un graph une couleur chacune que j'ai prédéterminé (une quinzaine toutes très différents: 46, 5 ,33, 13,..) ainsi qu'une certaine épaisseur cependant le nbre de courbes varie en fonction de la macro, comment est ce que je peux faire?
parce que j'ai essayé en définissant à l'avance un certain nombre de couleurs mais s'il y a plus de courbes que je n'en ai prévu, elles n'ont pas les couleurs que j'ai choisi, et s'il n'y en a pas assez, ca plante parce que forcément il ne les trouve pas :s

 

[porcinet82]

salut toubib,

Peut etre quelques elements qui te permettront d'avancer dans ta macro. Moi, je verrai bien une variable qui te defini le nombre de courbes que tu aura dans ton graphe, puis selon ce nombre, et en utilisant la methode Case, je pense que tu devrait pouvoir gérer un truc.

un petit exemple de ce que je veux dire parce que je ne sais pas si j'ai ete bien clair.

Nb_courbe=3 'par exemple

Select Case Nb_courbe
Case 1
   'courbe 1 prend la couleur rouge
Case 2
   'courbe 1 prend la couleur rouge
   'courbe 2 prend la couleur verte
Case 3
   'courbe 1 prend la couleur rouge
   'courbe 2 prend la couleur verte
   'courbe 3 prend la couleur bleue
...
End Select

Le probleme dans ce code, sais qu'il n'est pas tres optimisé, il risque meme d'etre enorme si tu as une quinzaine de courbes.

Ou alors une solution, toujours avec la methode Case, serait d'aller cherché des que tu crés une courbe la couleur associée, donc avec un truc du genre:

...
'Création de la courbe 1
Num_courbe=1 'puisque c'est la 1ere courbe
'Détermination de sa couleur
Goto Couleur
'Le reste de ton code
Exit Sub

Couleur:
Select Case Num_courbe
Case 1
   'courbe 1 prend la couleur rouge
Case 2
   'courbe 2 prend la couleur verte
Case 3
   'courbe 3 prend la couleur bleue
...
End Select

Bon ce sont des idées qui me passent dans la tete peut etre que ca va pouvoir t'aidé.

@+

 

[toubib]

merci c'est gentil, par contre j'ai un petit souci, c'est que j'en suis à mes balbutiements dans vba et je ne gère pas du tout la fonction case, seulement quelques trucs avec if, for mais ca va pas beaucoup plus loin :s
est ce qu'il te serait possible de développer un peu?
par ailleurs si ca fait un code lourd au-delà de 15 courbes ca risque d'être un peu rude parce que dans le pire des cas il doit y avoir 30 à 35 courbes :s (qu'on peut selectionner grâce à un usf je vous rassure )


je vais écrire une grosse bétise mais c'est pour schématiser, ne m'en voulez pas , on pourrait pas faire un truc du genre



for p = 1 to nb
if activechart.seriescollection(p)<>0 then
activechart.seriescollection(p).colorindex=x,y,,z,......
'on définit avant quel colorindex est associé à x, y, z,...
'a chaque next p, prendre la valeur suivante
activechart.seriescollection(p).linestyle=medium
end if
next p

je sais c'est pas beau et ca veut rien dire mais bon je pense que ca traduit bien plutôt bien ce que je veux dire

Message édité par: toubib, à: 12/10/2005 14:59

 

[porcinet82]

salut toubib,

Et bien je pense que ton code est tres proche de ce que je voulais faire avec mes Case dans le 2eme morceau de code que je t'ai proposé.

Effectivement je verrais bien un truc du genre:

For nb_courbe = 1 to nb_tot_courbe
If activechart.seriescollection(p)<>0 then
Activechart.Seriescollection(p).Colorindex=nb_courbe
Goto Couleur 'cette ligne fait faire 'un saut' au code et va directement a la ligne Couleur:
Activechart.seriescollection(p).linestyle=medium 
end if 
next p 
Exit sub 'necessaire pour arreter la macro sinon le code suivant sera encore executé

Couleur:
Select Case nb_courbe
Case 1
   'courbe 1 prend la couleur rouge
Case 2
   'courbe 2 prend la couleur verte
Case 3
   'courbe 3 prend la couleur bleue
...
End Select  
Exit sub

je pense que la macro devrait ressembler en gros a quel que chose de ce genre la.

Si tu n'arrive pas du tout a t'en sortir, met un fichier exemple avec des données bidons, et je verrais ce que je peux faire.

@+

 

[toubib]

Bonjour porcinet, bonjour les xldiens,

bon je viens de regarder (tardivement dsl) ce que tu m'as envoyé et j'ai essayé de l'adapter à mon projet mais j'avoue que ca marche pas des masses :s

d'abord il me disait qu'avec le if ca ne marchait pas parce que la propriété n'ets pas gérée par l'objet et si j'enlève le if, ca bug pas mais ca marche pas :angry:

donc moralité je galère un peu! si tu as des idées sur ce qui cloche je serais ravi de les entendre [file name=graph_20051017120502.zip size=38340]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/graph_20051017120502.zip[/file]

 

[porcinet82]

salut,

moi aussi je te repond assez tard, je crois avoir trouver la solution, ou ce qui y ressemble en tt cas.

essaye la macro suivante a la place de celle que tu avais:
seule chose, il faut que tu change Graphique 1 par le nom de ton graphique et ca devrait marcher. si ca ne marche pas, essaye de faire un graphe sur la feuille données et remplace la ligne Sheets('graph').ChartObjects('Graphique 1').Activate par la ligne Sheets('données').ChartObjects('Graphique 1').Activate et a toi de jouer

Sub Macroavance()

Dim p As Byte, nb As Byte, nb_courbe As Byte
Dim couleur_courbe As Byte
nb_courbe = 0
nb = Sheets('données').Range('a100').Value

Sheets('graph').ChartObjects('Graphique 1').Activate
For p = 1 To nb
nb_courbe = nb_courbe + 1
    GoTo Couleur 'cette ligne fait faire 'un saut' au code et va directement a la ligne Couleur:
retour:
    With Selection.Border
        .ColorIndex = couleur_courbe
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
Next p
Exit Sub 'necessaire pour arreter la macro sinon le code suivant sera encore executé

Couleur:
Select Case nb_courbe
Case 1
    couleur_courbe = 3
Case 2
    couleur_courbe = 6
Case 3
    couleur_courbe = 9

End Select
GoTo retour

End Sub

tiens moi au courant de l'evolution de ton projet

@+

 

[toubib]

bonjour porcinet82, le forum

merci bcp pour ton coup de main parce que la je galérais dur !!!!!!! ceci dit j'ai retouché un peu le code car chez moi ca ne fonctionnait pas, voila ce que ca donne:

Sub Macroavance()

Dim p As Byte, nb As Byte, nb_courbe As Byte
Dim couleur_courbe As Byte
nb_courbe = 0
nb = Sheets('données').Range('a100').Value

Charts('graph1').Activate
For p = 1 To nb
If ActiveChart.SeriesCollection(p).Name <> '' Then
nb_courbe = nb_courbe + 1
    GoTo Couleur 'cette ligne fait faire 'un saut' au code et va directement a la ligne Couleur:
retour:
    ActiveChart.SeriesCollection(p).Select
    With selection.Border
        .ColorIndex = couleur_courbe
        .Weight = xlMedium
    End With
    End If
Next p
Exit Sub 'necessaire pour arreter la macro sinon le code suivant sera encore executé

Couleur:
Select Case nb_courbe
Case 1
    couleur_courbe = 3
Case 2
    couleur_courbe = 6
Case 3
    couleur_courbe = 9

End Select
GoTo retour

End Sub

en tout cas je te remercie beaucoup pour ton aide TRES précieuse
bonne journée à toi et aux forumeurs

 

[porcinet82]

salut,

Et bien ca me fait plaisir d'avoir réussit a t'aider parce que les macro en relation avec les graphe, je ne m'en etait jamais servi jusque la, ne sachant pas trop m'en servir, mais grace a toi, j'ai pu une fois de plus approfondir mes quelques connaissance en vba.

Au plaisir de te recroisé sur le forum

@+