Couleurs dans un graphique

Le 14/04/2021 à 09:31

Bonjour à tout le monde,

Voilà mon souci : je travaille sur Excel 2016

J'ai créé un tableau récupérant les données d'un questionnaire contenant 5 thèmes.

Le tableau calcule des scores pour chaque thème, et une macro classe ces thèmes par ordre de score.

Un graphique présente les résultats (histogramme groupé 3D).

Je souhaiterais que la colonne représentant chaque thème reste de la même couleur quelle que soit le score et le classement du thème.

En clair, je veux que le thème 1 soit jaune, le 2 soit vert, le 3 soit violet... et que les colonnes du graphique respectent ces couleurs même lorsque les scores changent et que le classement change avec.

Seulement ce que j'obtiens pour l'instant c'est que la première colonne du graphique est toujours jaune, même si c'est le thème 2 ou 5 qui arrive en tête des scores...

Je ne sais pas si je suis clair, n'hésitez pas à questionner si ça ne l'est pas :o)

Merci d'avance de votre aide et bonne journée à vous

Le 14/04/2021 à 09:50

Bonjour,

Un fichier Excel (avec la macro en question) pour illustrer tout ça (et nous aider à faire des tests) ?

Le 14/04/2021 à 10:57
6drivers-messages-contraignants-test.xlsm (45.55 Ko)
Le 14/04/2021 à 10:58

Voilà le modèle de tableau (anonymé) que j'utilise

J'espère que ce sera plus clair comme ça

Merci

Le 14/04/2021 à 12:12

Un essai :

Sub résultats_pilotes_internes()

Dim i As Integer, C As Range

With Worksheets("Résultats")
    'Report des données source
    .Range("B3").Copy .Range("S3")
    .Range("B6").Copy .Range("S4")
    .Range("B9").Copy .Range("S5")
    .Range("B12").Copy .Range("S6")
    .Range("B15").Copy .Range("S7")
    .Range("N5:Q5").Copy
    .Range("T3:W3").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
    .Range("T3:W3").PasteSpecial Paste:=xlPasteValues
    .Range("N8:Q8").Copy
    .Range("T4:W4").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
    .Range("T4:W4").PasteSpecial Paste:=xlPasteValues
    .Range("N11:Q11").Copy
    .Range("T5:W5").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
    .Range("T5:W5").PasteSpecial Paste:=xlPasteValues
    .Range("N14:Q14").Copy
    .Range("T6:W6").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
    .Range("T6:W6").PasteSpecial Paste:=xlPasteValues
    .Range("N17:Q17").Copy
    .Range("T7:W7").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
    .Range("T7:W7").PasteSpecial Paste:=xlPasteValues

    'Tri des données
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=.Range("T3:T7"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    .Sort.SetRange Range("S3:W7")
    .Sort.Header = xlGuess
    .Sort.MatchCase = False
    .Sort.Orientation = xlTopToBottom
    .Sort.SortMethod = xlPinYin
    .Sort.Apply

    'Exportation et mise en forme des données triées
    .Range("S3:T7").Copy Sheets("Compte-rendu").Range("B12:E16")
    Sheets("Compte-rendu").Range("B12:E16").HorizontalAlignment = xlLeft
    Sheets("Compte-rendu").Range("B12:E16").VerticalAlignment = xlCenter
    Sheets("Compte-rendu").Range("B12:E16").WrapText = False
    Sheets("Compte-rendu").Range("B12:E16").Orientation = 0
    Sheets("Compte-rendu").Range("B12:E16").AddIndent = False
    Sheets("Compte-rendu").Range("B12:E16").IndentLevel = 0
    Sheets("Compte-rendu").Range("B12:E16").ShrinkToFit = False
    Sheets("Compte-rendu").Range("B12:E16").ReadingOrder = xlContext
    Sheets("Compte-rendu").Range("B12:E16").MergeCells = False
    .Range("S3:S7").Copy Sheets("Compte-rendu").Range("B29:B33")
    .Range("U3:W7").Copy Sheets("Compte-rendu").Range("C29:E33")
    Application.CutCopyMode = False
End With

'Mise en forme graphique
With Worksheets("Compte-rendu")
    .ChartObjects("Graphique 2").Select
    For i = 1 To 5
        Set C = .Range("C" & i + 11)
        ActiveChart.SeriesCollection(1).Points(i).Format.Fill.ForeColor.RGB = RGB(GetRGBcolor(C)(0), GetRGBcolor(C)(1), GetRGBcolor(C)(2))
    Next i
End With

End Sub
Private Function GetRGBcolor(ByVal Cellule As Range) As Integer()

    Dim Couleur As Long, Res(2) As Integer

    If Cellule.Count > 1 Then Set Cellule = Cellule.Cells(1, 1)
    Couleur = Cellule.Interior.Color
    Res(0) = Couleur Mod 256
    Res(1) = (Couleur \ 256) Mod 256
    Res(2) = Couleur \ 65536
    GetRGBcolor = Res

End Function
Le 14/04/2021 à 14:20

Question bête, je dois remplacer ma macro par ce que tu proposes Pedro22 ?

Le 14/04/2021 à 14:22

Oui, j'ai modifié le code existant, et ajouté une section à la fin pour appliquer aux points la même couleur de fond que les cellules de la plage source.

Le 14/04/2021 à 15:35

J'ai essayé, mais une ligne me renvoie un premier bug :

ActiveChart.SeriesCollection(1).Points(i).Format.Fill.ForeColor.RGB = RGB(GetRGBcolor(C)(0), GetRGBcolor(C)(1), GetRGBcolor(C)(2))

Le 14/04/2021 à 15:36
oberon03 a écrit :

J'ai essayé, mais une ligne me renvoie un premier bug :

ActiveChart.SeriesCollection(1).Points(i).Format.Fill.ForeColor.RGB = RGB(GetRGBcolor(C)(0), GetRGBcolor(C)(1), GetRGBcolor(C)(2))

Quel est le message d'erreur ?

Avez vous bien collé le code de la fonction à la suite de la macro (c'est à dire la totalité du code transmis) ?

Si besoin, votre fichier modifié :

20drivers-messages-contraignants-test.xlsm (48.87 Ko)
Le 14/04/2021 à 15:46

j'avais bien tout collé, et dans le fichier que vous avez mis, j'ai le même souci :

Erreur d'exécution '91':

Variable objet ou variable de bloc with non définie

Le 14/04/2021 à 15:57

Je n'ai pas d'explication, chez moi ça fonctionne correctement, au moins sur le fichier de test !

Le 14/04/2021 à 21:30

Je n'ai pas d'explication non plus, d'autant que j'avoue que je ne comprends rien au code que vous m'avez proposé ;o))

Donc je ne risque pas de le débuguer...

Merci en tout cas de votre aide et du temps passé sur mon problème. D'autres utilisateurs du forum auront peut-être une explication, ou une autre stratégie

Bonne soirée à vous

Le 14/04/2021 à 22:38

Je peux toujours le commenter si ça vous intéresse.

Le 15/04/2021 à 12:57

Bonjour à tous,

j'ai également une erreur avec ma version,

ceci fonctionne chez moi

   'Mise en forme graphique
    With Worksheets("Compte-rendu")
        Set ch = .ChartObjects("Graphique 2").Chart
        For i = 1 To 5
            Set C = .Range("C" & i + 11)
            ch.SeriesCollection(1).Points(i).Format.Fill.ForeColor.RGB = C.Interior.Color
        Next i
    End With
Le 16/04/2021 à 11:01

Merci Pedro22 pour votre proposition de commenter le code, ça m'intéresse toujours de comprendre les choses, donc je veux bien :o)

Et pour h2so4 le code que vous avez modifié semble fonctionner parfaitement !!!

Je vais retester plusieurs fois pour être sûr, mais ça a marché sans bug cette fois ! C'est super merci beaucoup !

Le 16/04/2021 à 11:49

Bonjour,

Le code commenté, incluant l'extrait donné par h2so4 :

Sub résultats_pilotes_internes()

Dim i As Integer, C As Range, ch As Variant 'Déclaration des variables

With Worksheets("Résultats") 'Tout objet qui commence par "." se rapporte à cette feuille
    'Report des données source
    .Range("B3").Copy .Range("S3") 'Copie B3 vers S3
    .Range("B6").Copy .Range("S4") 
    .Range("B9").Copy .Range("S5")
    .Range("B12").Copy .Range("S6")
    .Range("B15").Copy .Range("S7")
    .Range("N5:Q5").Copy
    .Range("T3:W3").PasteSpecial Paste:=xlPasteAllUsingSourceTheme 
    .Range("T3:W3").PasteSpecial Paste:=xlPasteValues
    .Range("N8:Q8").Copy
    .Range("T4:W4").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
    .Range("T4:W4").PasteSpecial Paste:=xlPasteValues
    .Range("N11:Q11").Copy
    .Range("T5:W5").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
    .Range("T5:W5").PasteSpecial Paste:=xlPasteValues
    .Range("N14:Q14").Copy
    .Range("T6:W6").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
    .Range("T6:W6").PasteSpecial Paste:=xlPasteValues
    .Range("N17:Q17").Copy
    .Range("T7:W7").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
    .Range("T7:W7").PasteSpecial Paste:=xlPasteValues

    'Tri des données
    .Sort.SortFields.Clear 'Réinitialise les éventuels filtres déjà appliqués
    .Sort.SortFields.Add Key:=.Range("T3:T7"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal 'Tri décroissant colonne T
    .Sort.SetRange Range("S3:W7") 'Plage d'application du tri
    .Sort.Header = xlGuess
    .Sort.MatchCase = False
    .Sort.Orientation = xlTopToBottom
    .Sort.SortMethod = xlPinYin
    .Sort.Apply

    'Exportation et mise en forme des données triées
    .Range("S3:T7").Copy Sheets("Compte-rendu").Range("B12:E16") 'Copie Résultats!S3:T7 vers Compte-rendu!B12:E16
    Sheets("Compte-rendu").Range("B12:E16").HorizontalAlignment = xlLeft 'Alignement horizontal à gauche
    Sheets("Compte-rendu").Range("B12:E16").VerticalAlignment = xlCenter 'Centrage vertical
    Sheets("Compte-rendu").Range("B12:E16").WrapText = False
    Sheets("Compte-rendu").Range("B12:E16").Orientation = 0
    Sheets("Compte-rendu").Range("B12:E16").AddIndent = False
    Sheets("Compte-rendu").Range("B12:E16").IndentLevel = 0
    Sheets("Compte-rendu").Range("B12:E16").ShrinkToFit = False
    Sheets("Compte-rendu").Range("B12:E16").ReadingOrder = xlContext
    Sheets("Compte-rendu").Range("B12:E16").MergeCells = False 'Défusionne cellules
    .Range("S3:S7").Copy Sheets("Compte-rendu").Range("B29:B33")
    .Range("U3:W7").Copy Sheets("Compte-rendu").Range("C29:E33")
    Application.CutCopyMode = False 'Désactive le mode copier-coller 
End With

'Mise en forme graphique
With Worksheets("Compte-rendu") 'Tout objet qui commence par "." se rapporte à cette feuille
    Set ch = .ChartObjects("Graphique 2").Chart 'Stocke le graphique dans une variable nommée "ch"
    For i = 1 To 5 'Boucle sur les séries
        Set C = .Range("C" & i + 11) 'Stocke la cellule source correspondante dans une variable nommée C
        ch.SeriesCollection(1).Points(i).Format.Fill.ForeColor.RGB = C.Interior.Color 'Applique la même couleur à la série que la cellule source
    Next i
End With

End Sub
Le 16/04/2021 à 12:05

Merci Pedro22 c'est beaucoup plus clair pour moi !!

C'est super gentil d'avoir pris autant de temps pour m'aider :o)

Je peux clôturer le sujet du coup, Merci à vous deux !

Le 16/04/2021 à 12:06

Merci du retour, et bonne continuation !

Le 16/04/2021 à 12:08

Merci, à vous aussi ;o)

Rechercher des sujets similaires à "couleurs graphique"