XL 2019 VBA - Simplifier un code fait par enregistrement

ruliann · 9 Octobre 2022

bonjour,

Je suis en train de réaliser un graph en anneau sur le fichier ci-joint. J'ai réalisé ce graph en suivant ce tuto et j'aimerais simplifier l'étape fastidieuse du coloriage de chacun des segments...

Chacun des 8 anneaux est divisé en 96 segments, et chacun de ces segments sera colorié selon une suite de 8 couleurs : rouge / orange/orange clair / jaune..../ blanc.

Alors j'ai testé la fonction enregistrement de macro pour le coloriage "en rouge" du 1er anneau, ce qui me donne le code ci-dessous. Le code fonctionne mais est fastidieux à modifier.

Je n'y connais rien en VBA mais j'ai envie d'apprendre. Je pense que la logique VBA voudrait que je fasse une boucle sur les 96 segments du 1er anneau ActiveChart.FullSeriesCollection(1), que le point 1 soit colorié en rouge, puis le point1+8 (soit le point 9) soit colorié en rouge lui aussi, puis le point9+8 (soit le point 17) soit colorié en rouge, etc....jusqu'au point 12.

Je ne sais pas comment initié la boucle et intégrer la ou les variables. Sauriez-vous me guider?

VB:

Sub Anneau1_color1()
'
' Anneau1_color1 Macro
'

'
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(1).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(2).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(3).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(4).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(5).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(6).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(7).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(8).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(9).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(10).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(11).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(12).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(13).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(14).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(15).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(16).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(17).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(18).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(19).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(20).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(21).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(22).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(23).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(24).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(25).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(26).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(27).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(28).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(29).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(30).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(31).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(32).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(33).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(34).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(35).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(36).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(37).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(38).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(39).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(40).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(41).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(42).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(43).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(44).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(45).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(46).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(47).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(48).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(49).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(50).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(51).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(52).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(53).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(54).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(55).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(56).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(57).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(58).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(59).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(60).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(61).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(62).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(63).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(64).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(65).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(66).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(67).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(68).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(69).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(70).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(71).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(72).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(73).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(74).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(75).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(76).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(77).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(78).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(79).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(80).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(81).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(82).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(81).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(82).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(83).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(84).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(85).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(86).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(87).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(88).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(89).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
End Sub

Staple1600 · 16 Octobre 2022

Bonjour @ruliann , le fil

Pour ce qui est du graphique

VB:

Sub Colorer_Graphique_C()
Dim i&, j&
Application.ScreenUpdating = False
With ActiveSheet.ChartObjects("Graphique 1").Chart
    For j = 1 To 8
            For i = 1 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = Cells(23, "B").Interior.Color
            Next i
            For i = 2 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = Cells(24, "B").Interior.Color
            Next i
            For i = 3 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = Cells(25, "B").Interior.Color
            Next i
            For i = 4 To 96 Step 8...

ruliann · 10 Octobre 2022

Staple1600 à dit:
Re

@ruliann
Pour info (et en guise d'indice), ma dernière version ne contient plus que six lignes de codes VBA.

Voilà un challenge pour la semaine prochaine

J'ai pas eu le temps aujourd'hui mais en 6 lignes, tu comptes le sub et endsub? va me falloir 1 mois là...

Staple1600 · 10 Octobre 2022

Bonsoir le fil, @ruliann

6 lignes sans les Sub/End Sub

NB: Si tu veux, je peux publier ma solution, si tu ne peux plus attendre
Ou alors je te laisse encore du temps pour faire chauffer tes neurones

ruliann · 11 Octobre 2022

je vais chercher encore... pour le moment je n'ai fait que récupérer les codes couleurs : je me demande s'il me les faut en mode RGB ou peu importe ?

ruliann · 12 Octobre 2022

@Staple1600 J'ai 2 pistes ici et là, mais pas de résultat concret pour le moment Je prends ta solution volontiers si tu l'as encore sous le coude!

Cela dit, est-ce que c'est possible de changer la couleur d'une ou plusieurs séries d'un graph pour tous les types de chart? Par un exemple, un graph en compartiment, ou Teechart : si j'ai une série de données sur 1 colonne, et que je colorie cette colonne en 4 couleurs. Est-ce possible d'appliquer sur ce genre de chart la couleur des cellules aux séries de données?

Ca sort un peu du sujet vu que je change de type de graph, mais ca m'a donné une autre idée de représentation. J'aime bien le graph en compartimentage aussi

Staple1600 · 12 Octobre 2022

Bonsoir le fil, @ruliann

VB:

Sub Colorer_Graphique_B()
Dim i&, j&, couleur&
With ActiveSheet.ChartObjects("Graphique 2").Chart
    For j = 1 To 8
    couleur = Cells(j + 2, "AZ").Interior.Color
    For i = 1 To 96: .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = couleur: Next i
    Next j
End With
End Sub

ruliann · 13 Octobre 2022

Staple1600 à dit:

Bonsoir le fil, @ruliann

VB:

Sub Colorer_Graphique_B()
Dim i&, j&, couleur&
With ActiveSheet.ChartObjects("Graphique 2").Chart
    For j = 1 To 8
    couleur = Cells(j + 2, "AZ").Interior.Color
    For i = 1 To 96: .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = couleur: Next i
    Next j
End With
End Sub

merci beaucoup! encore une question de newbie : je l'intègre dans un module à part ou dans l'autre macro?

Staple1600 · 13 Octobre 2022

Bonsoir le fil le fil , @ruliann

Dans un premier temps pour tester dans un module à part.

Une fois testée, la question est: obtient-on le résultat escompté ?

ruliann · 14 Octobre 2022

Staple1600 à dit:
Bonsoir le fil le fil , @ruliann

Dans un premier temps pour tester dans un module à part.

Une fois testée, la question est: obtient-on le résultat escompté ?

salut le fil

@Staple1600 : cela colorie chaque anneau, en partant du plus petit au plus grand, selon les couleurs issues des cellules indiquées, donc en soi oui cela fonctionne.

Mais, je me suis mal exprimé, et j'ai pris le temps avant de te répondre pour savoir si ce que je veux faire est censé ou pas. Je joins le fichier pour mieux comprendre.

Ce que je cherchais à faire, c'est à modifier les couleurs du graphique : actuellement elles vont du rouge au vert en passant par le jaune selon la note contenu dans le tableau, mais si demain je veux changer ma palette de couleur pour des couleurs allant du orange au bleu par exemple, je me disais que ce serait bien que je n'ai qu'à changer les couleurs des cellules (B27:B34), pour que la couleur de ces dernières soient reprises pour colorier les anneaux du graphique.

Mais je dois dire que la conception même de ce graphique est un peu tordue...(voir l'onglet graphique pour davantage de détails).

Par contre, pour changer la palette de couleur à utiliser, j'ai pensé qu'à partir de ton code :

VB:

Sub Colorer_Graphique()
Dim i&, j&
With ActiveSheet.ChartObjects("Graphique 1").Chart
    For j = 1 To 8
            For i = 1 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = RGB(255, 80, 80)
            Next i
            For i = 2 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = RGB(255, 153, 0)
            Next i
            For i = 3 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = RGB(255, 204, 0)
            Next i
            For i = 4 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = RGB(255, 255, 0)
            Next i
            For i = 5 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = RGB(153, 255, 153)
            Next i
            For i = 6 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = RGB(102, 255, 51)
            Next i
            For i = 7 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = RGB(0, 153, 0)
            Next i
            For i = 8 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = RGB(255, 255, 255)
            Next i
    Next j
End With
End Sub

ce qu'il faudrait que je fasse, c'est que pour chacune des lignes où il y a l'expression RGB(000, 000, 000), peut-être qu'il serait possible de remplacer par une variable qui appelle la couleur contenue dans la cellule correspondante?

Par exemple, pour la 1ère couleur du code, remplacer l'expression RGB(255, 80, 80) par la couleur contenue dans la cellule B27

Code:

FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = RGB(255, 153, 00)

Par exemple pour la 2ème couleur du code, remplacer l'expression RGB(255, 153, 00) par la couleur contenue dans la cellule B28

etc...pour la suite du code.

Je ne sais pas si c'est possible?

et puis 2ème souhait : c'est que les couleurs du tableau (qui sont actuellement formatées via MFC selon une note allant de 0 à 7) suivent aussi le changement de couleur opérées dans les cellules...

Staple1600 · 14 Octobre 2022

Bonsoir le fil

@ruliann
Tu as écrit

Je vais me lancer un défi : celui de récupérer le "code VBA" des 8 couleurs qui sont dans la colonne AZ, de manière à ce que si je change la couleur de ces 8 cellules, les mêmes couleurs soient reprises dans le code ci-dessous.

C'est ce que fait mon code court du message#23

Pourquoi tu rallonges la sauce dans le message#25 ???
(le but initial étant d'avoir un procédure VBA concise)

ruliann · 14 Octobre 2022

Staple1600 à dit:
Bonsoir le fil

@ruliann
Tu as écrit

C'est ce que fait mon code court du message#23

Pourquoi tu rallonges la sauce dans le message#25 ???
(le but initial étant d'avoir un procédure VBA concise)

@Staple1600 hello, car j'ai peut etre mal exprimé ma demande. Ton code répond à ce que j'ai formulé, mais ce que j'ai formulé correspond-t-il à ce que j essaye de faire...? Ce graph est joli mais tordu à utiliser... Mon stress est qu on me dise je veux un dégradé de bleu a la place du rouge au vert!

@ChTi160 et @ Staple1600 Je reteste demain vos 2 solutions

Staple1600 · 14 Octobre 2022

Re

@ruliann
"Ce que l'on conçoit bien s’énonce clairement,
Et les mots pour le dire arrivent aisément" Nicolas B.

1) Quel est le contexte ?
2) Quel type de données ?
3) Pourquoi ce type de graphique (et pas un de ceux proposés par défaut par Excel) ?

ruliann · 16 Octobre 2022

Pour le contexte, je cherchais une représentation graphique permettant de faire des rosaces. Après avoir trituré le mode "graph radar" d'excel, le rendu n'était pas satisfaisant. Ce qui se rapprochait le plus étaient les graph de type sunburst, à la différence que pour mon graph, je voulais que touts les parts du gateaux soient égales.

Dans le fichier joint, je renseigne d'abord le tableau :

> ce tableau compare 6 types de voitures (v1, v2...), selon 12 critères (input 1, input2....).
> j'attribue une note allant de 1 à 7 pour chacun des critères (le 8 n'est pas une note, c'est pour créer du blanc dans le graphique).
> via une MFC, les cellules se colorient en fonction de la note.

Les données du tableau viennent ensuite alimenter les séries du graph.

Ainsi, dans la feuille "Graphique" on a :

> les cellules C3:C14 qui contiennent un "R" si la cellule C4 du tableau est <= à 1 (c'est à dire toutes vu que 1 est la note mini)
> les cellules I3:I14 qui contiennent un "O" (pour Orange) ou un "B" (pour Blanc) si la cellule C4 du tableau est => à 2
> les cellules O3:O14 qui contiennent un "J" (pour Jaune) ou un "B" (pour Blanc) si la cellule C4 du tableau est => à 3
> les cellules U3:U14 qui contiennent un "JJ" (pour Jaune clair) ou un "B" (pour Blanc) si la cellule C4 du tableau est => à 4

Les couleurs de ces cellules répondent aussi à des MFC.

Ensuite :

Dans la feuille "Graphique" toujours, à partir de la ligne 18, chacun des 12 compartiments du graph est décomposé en 8 lignes vu qu'il y a 8 cas de couleurs possibles : Rouge, Orange, Jaune....

Quant au graphique lui-même, ses couleurs sont formatées laborieuseument : à la création du graph, chacun des 96 segments (12 X 8) de chaque anneau est colorié via la macro contenue dans le Module 9 (voir mon Post 1).

*****************

Le graph fonctionne bien j'en suis content.

Mon problème c'est de pouvoir changer aisément le jeu de couleurs du tableau ET du graph en fonction des gouts de chacun ; par exemple si je veux une palette allant du orange au bleu foncé pour les 7 niveaux de notation (+ le blanc), ou bien une palette de 7 bleus dégradés...

Ce changement de couleur doit s'effectuter aussi bien pour les couleurs du tableau, que pour les couleurs du graph puisqu'il faut que la même palette soi utilisée pour le Tableau et pour le graph.

D'où mon idée : si je change les couleurs contenues entre B23:B30, les couleurs du graph et du tableau s'adapteraient automatiquement...

Je ne sais pas si c'est + clair pour vous cette histoire de pouvoir changer les couleurs?

Staple1600 · 16 Octobre 2022

Bonjour @ruliann , le fil

Pour ce qui est du graphique

VB:

Sub Colorer_Graphique_C()
Dim i&, j&
Application.ScreenUpdating = False
With ActiveSheet.ChartObjects("Graphique 1").Chart
    For j = 1 To 8
            For i = 1 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = Cells(23, "B").Interior.Color
            Next i
            For i = 2 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = Cells(24, "B").Interior.Color
            Next i
            For i = 3 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = Cells(25, "B").Interior.Color
            Next i
            For i = 4 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = Cells(26, "B").Interior.Color
            Next i
            For i = 5 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = Cells(27, "B").Interior.Color
            Next i
            For i = 6 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = Cells(28, "B").Interior.Color
            Next i
            For i = 7 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = Cells(29, "B").Interior.Color
            Next i
            For i = 8 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = Cells(30, "B").Interior.Color
            Next i
    Next j
End With
End Sub

Et en guise de piste à creuser pour la plage de cellule
Mettre un fond de couleur en B23 puis lancer cette macro

VB:

Sub degrade()
Dim coul&, i&
coul = Cells(23, "B").Interior.Color
For i = 8 To 2 Step -1
Cells(i + 22, "B").Interior.Color = coul
Cells(i + 22, "B").Interior.TintAndShade = ((i - 1) + i / 13) / 8
Next
End Sub

ruliann · 17 Octobre 2022

@Staple1600

super cela correspond à ce que j'imaginais.
Merci pour pour la patience! et merci aussi ainsi qu'à @ChTi160 d'être intervenu ponctuellement

Sur la base de cette macro, je devrais pouvoir l'adapter au tableau pour que ce dernier adopte lui aussi la palette de couleurs choisies

Edit : voilà mon code pour colorier le tableau. Il fonctionne, mais peut sûrement être simplifié :

VB:

Sub test1()

Dim C&, i&

For C = 1 To 8

  For i = 4 To 15

  If Cells(i, C) = 1 Then

  Range(Cells(i, C), Cells(i, C)).Interior.Color = Cells(23, "B").Interior.Color

       Else
 
          If Cells(i, C) = 2 Then

          Range(Cells(i, C), Cells(i, C)).Interior.Color = Cells(24, "B").Interior.Color
        
               Else

                  If Cells(i, C) = 3 Then

                  Range(Cells(i, C), Cells(i, C)).Interior.Color = Cells(25, "B").Interior.Color

                       Else

                          If Cells(i, C) = 4 Then

                          Range(Cells(i, C), Cells(i, C)).Interior.Color = Cells(26, "B").Interior.Color
                        
                               Else

                                  If Cells(i, C) = 5 Then

                                  Range(Cells(i, C), Cells(i, C)).Interior.Color = Cells(27, "B").Interior.Color
                                
                                       Else

                                          If Cells(i, C) = 6 Then

                                          Range(Cells(i, C), Cells(i, C)).Interior.Color = Cells(28, "B").Interior.Color
                                        
                                                     Else

                                                     If Cells(i, C) = 7 Then

                                                     Range(Cells(i, C), Cells(i, C)).Interior.Color = Cells(29, "B").Interior.Color

   End If
     End If
       End If
         End If
           End If
             End If
               End If
 
  Next

Next

End Sub

Staple1600 · 17 Octobre 2022

Bonjour @ruliann , le fil

C'est pas mal comme simplification, non ?

VB:

Sub Colorer_Tableaux()
For Each c In Range("A1:H15")
c.Interior.Color = Cells(Array(23, 24, 25, 26, 27, 28, 29)(c.Value - 1), 2).Interior.Color
Next
End Sub

NB: Test OK
(attention pas de cellule vide en A1:H15 et uniquement des valeurs de 1 à 7)

XL 2019 VBA - Simplifier un code fait par enregistrement

ruliann

XLDnaute Occasionnel

Pièces jointes

Staple1600

ruliann

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

ruliann

XLDnaute Occasionnel

ruliann

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

ruliann

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

ruliann

XLDnaute Occasionnel

Pièces jointes

Staple1600

XLDnaute Barbatruc

ruliann

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

ruliann

XLDnaute Occasionnel

Pièces jointes

Staple1600

XLDnaute Barbatruc

ruliann

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

Discussions similaires