Mettre en forme séries graphique via tableau

Version imprimable

21/04/2020, 14h24
PaulG2B

2 pièce(s) jointe(s)

Mettre en forme séries graphique via tableau

Bonjour,

J'ignore si ma requête est réalisable et après plusieurs essais infructueux je tiens à vous soumettre a question avant de laisser tomber.

Je souhaiterais développer une fonction qui me permette de manipuler simplement la mise en forme des séries d'un graphique. Le grahique est toujours le même, seul le nombre de séries varient.

J'avais pensé sur une feuille renseigner la mise en forme puis l'envoyer vers le graphique, sur cette feuille j'avais l'idée de rentrer les renseignements suivants :

Pièce jointe 558730

Merci pour vos éclairages.

Bonn journée.

Bonjour,

Oui, cela est tout à fait possible avec une macro.
Un début:

Code:

1
2
3
4
5
6
7
8
Sub MiseEnForme()
    ActiveSheet.ChartObjects("Graphique 1").Activate
    With ActiveChart.SeriesCollection(1)
        .MarkerStyle = 1                                '--- forme
        .Format.Fill.ForeColor.RGB = RGB(255, 255, 0)   '--- couleur fond forme
        .Format.Line.ForeColor.RGB = RGB(255, 153, 0)   '--- couleur trait
    End With
End Sub

Cordialement.

1 pièce(s) jointe(s)

Bonjour,

Une façon de faire, en utilisant les couleurs mises en "couleur de fond" des cellules modèles (plutôt que d'utiliser des valeurs RGB). A adapter.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Option Explicit
 
Sub MiseEnFormes()
    Dim myChartObject As ChartObject
    Dim mySrs As Series
    Dim sC As String, kR As Long, kC As Long
    Dim sCode As String, rCode As Range
    With ActiveSheet
        For Each myChartObject In .ChartObjects
            For Each mySrs In myChartObject.Chart.SeriesCollection
                '--- position légende (titre) de la série
                sC = mySrs.Formula                      '--- formule de la série
                sC = Mid(sC, 9, InStr(sC, ",") - 9)     '--- adresse de la légende
                kR = Range(sC).Row
                kC = Range(sC).Column
                If myChartObject.Name = "GraphABC" Then
                    '--- suppose que le "code" est à gauche de la légende (en colonne)
                    sCode = Cells(kR, kC - 1)
                ElseIf myChartObject.Name = "GraphXY" Then
                    '--- suppose que le "code" est au dessus de la légende (en ligne)
                    sCode = Cells(kR - 1, kC)
                Else
                    MsgBox "Autre graphe. Non prévu !"
                    Exit Sub
                End If
                '--- modification de la série
                If sCode = "" Then
                    '--- ne rien changer à la série
                Else
                    Set rCode = Range("I5:I7")          '--- plage des codes
                    Set rCode = rCode.Find(sCode)
                    If rCode Is Nothing Then
                        MsgBox "Ce code " & sCode & " ne figure pas dans la liste des codes."
                        Exit Sub
                    End If
                    With mySrs
                        .MarkerStyle = rCode.Offset(0, 3)                               '--- forme
                        .Format.Fill.ForeColor.RGB = rCode.Offset(0, 1).Interior.Color  '--- couleur fond forme
                        .Format.Line.ForeColor.RGB = rCode.Offset(0, 2).Interior.Color  '--- couleur trait
                    End With
                End If
            Next
        Next
    End With
    Set rCode = Nothing
End Sub

L'exemple donné traite de 2 cas, l'un où les codes sont placés à gauche des légendes (en colonne), l'autre où les codes sont placés au dessus des légendes (en ligne).

Bonne continuation.

23/04/2020, 10h44
PaulG2B

Bonjour EricDgn,
Merci pour votre réponse, ça semble répondre à mes besoins c'est vraiment super.
Je vais regarder cela en détail et vous ferez un retour.
Bonne continuation.
23/04/2020, 15h03
PaulG2B

Bon alors je reviens tardivement car j'ai mis un certain temps à comprendre ce code, j'en comprend les grandes lignes même si certaines fonctions me sont obscures.

Après intégration dans mon classeur je rencontre un souci avec la ligne sC = mySrs.Formula ça bug avec une erreur d'exécution 2023

Citation:

Erreur définit par l'application ou par l'objet

Mon graphique est pourtant bien définit j'ai vérifié les séries tout semble normal.

Une idée sur ce qui pourrait poser problème ?

Commencer par vérifier que cela avance correctement, en ajoutant quelques Debug.Print:

Code:

1
2
3
4
5
6
...
        For Each myChartObject In .ChartObjects
            Debug.Print myChartObject.Name
            For Each mySrs In myChartObject.Chart.SeriesCollection
                Debug.Print mySrs.Name
...

Cdt

Bon alors je progresse un peu, j'ai résolu le démarrage comme je n'ai qu'un graphique sur cette feuille. Voici le début :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Sub MiseEnForme() 'Mise en forme du graphique Dim mySrs As Series Dim sC As String, kR As Long, kC As Long Dim sCode As String, rCode As Range With ActiveSheet.ChartObjects("Graphique 8").Activate For Each mySrs In ActiveChart.SeriesCollection sC = mySrs.Formula sC = Mid(sC, 9, InStr(sC, ",") - 9) kR = Range(sC).Row kC = Range(sC).Column
Là ça passe, maintenant j'ai stocké la mise en forme sur une autre feuille ...

Code:

Set rCode = Sheets("MForme").Range("A2:A27")

Et maintenant je bute au moment d'utiliser rCode ...

Code:

.MarkerStyle = rCode.Offset(0, 2)

Je suppose que je dois indiquer la feuille quelque part, ça fait chauffer les neurones :roll:

23/04/2020, 16h26
EricDgn
Après avoir calculé kR et kC, il faut aller rechercher la valeur sCode selon l'instruction qui se trouve en ligne 18 (codes à gauche, en colonne) ou en ligne 23 (codes au-dessus, en ligne).
Attention: il y a 2 lignes pour rCode
Code:

1 2 Set rCode = Range("I5:I7") '--- plage des codes Set rCode = rCode.Find(sCode)
Cdt
23/04/2020, 16h47
PaulG2B

C'est passionnant mais j'avoue que je suis au dessus de mon niveau en VB :aie:

Quand je progresse avec F8 les variables se remplissent bien et avec les bonnes valeurs que ce soit pour kR, kC, sCode ou rCode. Ça bug au moment de rappeler rCode pour attribuer les valeurs de mise en forme.

J'ai essayé style .Format.Fill.ForeColor.RGB = Sheets("MForme").Range(rCode).Offset(0, 3).Interior.Color.

Sans succès ... mais j'abandonne pas.

Que vous donne le debug.print tel que placé ci-dessous:

Code:

1
2
3
                    Set rCode = Sheets("MForme").Range("A2:A27")
                    Set rCode = rCode.Find(sCode)
                    Debug.Print rCode.Address, rCode.Offset(0, 1).Address

Cdt

Bon je suis un boulet, je viens de me rendre compte que ce n'est pas du tout rCode qui pose soucis mais mes commandes de mise en forme que j'ai ajouté à votre code ...

Code:

1
2
3
4
5
6
7
8
9
           With mySrs
                        .Format.Fill.Visible = rCode.Offset(0, 1)                                   'Forme visible ou non
                        .MarkerStyle = rCode.Offset(0, 2)                                           'Forme
                        .MarkerSize = rCode.Offset(0, 4)                                            'Taille de la forme
                        .Format.Fill.ForeColor.RGB = rCode.Offset(0, 3).Interior.Color    'Couleur fond forme
                        .Format.Line.Visible = rCode.Offset(0, 5)                                 'Trait visible ou non
                        .Format.Line.Style = rCode.Offset(0, 6)                                    'Style du trait
                        .Format.Line.Weight = rCode.Offset(0, 8)                                 'Largeur du trait
                        .Format.Line.ForeColor.RGB = rCode.Offset(0, 7).Interior.Color  'Couleur trait

23/04/2020, 17h17
PaulG2B
Citation:
Envoyé par EricDgn

Que vous donne le debug.print tel que placé ci-dessous:

Code:

1 2 3 Set rCode = Sheets("MForme").Range("A2:A27") Set rCode = rCode.Find(sCode) Debug.Print rCode.Address, rCode.Offset(0, 1).Address

Cdt
Cela me renvoi : $A$2 $B$2

En tout cas je vous remercie sincèrement pour le temps que vous avez passé à m'aider, j'ai appris encore plein de choses. :mouarf1:
23/04/2020, 18h21
EricDgn

Ok, je vois que vous avez compris le principe.
Yapluka ... mettre les bonnes valeurs aux bons endroits!
Bonne continuation.

1 pièce(s) jointe(s)

Je suis vraiment satisfait du résultat, j'ai légèrement modifié le code de EricDng pour l'adapter à mes besoins. Mais je suis très reconnaissant de ce partage qui m'a apprit pleins de choses.

Je bute néanmoins sur la condition visible ou pas (lignes en rouge dans le code) conditionnée par les colonnes "Visible" de mon panneau de mise en forme.

Pièce jointe 560778

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Sub MiseEnForme() '--- Mise en forme du graphique

    Dim mySrs As Series
    Dim sC As String, kR As Long, kC As Long
    Dim sCode As String, rCode As Range
    
    With ActiveSheet.ChartObjects("Graphique 8").Activate

             For Each mySrs In ActiveChart.SeriesCollection
                '--- Position légende (titre) de la série
                sC = mySrs.Formula                      '--- Formule de la série
                sC = Mid(sC, 9, InStr(sC, ",") - 9)     '--- Adresse de la légende
                kR = Range(sC).Row
                kC = Range(sC).Column
                
                
                sCode = Cells(kR - 1, kC)   '--- Le "code" est au dessus de la légende (en ligne)
                
                '--- Modification de la série
                If sCode = "" Then
                    '--- Ne rien changer à la série si vide
                Else
                    Set rCode = Sheets("MForme").Range("A3:A28")    '--- Plage des codes
                    Set rCode = rCode.Find(sCode)                   '--- Recherche des correspondances
                    
                        If rCode Is Nothing Then
                            MsgBox "Ce code " & sCode & " ne figure pas dans la liste des codes."
                            Exit Sub
                        End If
                        
                    With mySrs
'                        .Format.Fill.Visible = rCode.Offset(0, 1)                               '--- Marker visible ou non
                        .MarkerStyle = rCode.Offset(0, 2)                                       '--- Type de marker
                        .MarkerBackgroundColor = rCode.Offset(0, 3).Interior.Color              '--- Couleur remplissage marker
                        .MarkerForegroundColor = rCode.Offset(0, 4).Interior.Color              '--- Couleur contour marker
                        .MarkerSize = rCode.Offset(0, 5)                                        '--- Taille du marker
'                        .Format.Line.Visible = rCode.Offset(0, 6)                               '--- Trait visible ou non
                        .Format.Line.Style = rCode.Offset(0, 7)                                 '--- Ligne composition
                        .Format.Line.DashStyle = rCode.Offset(0, 8)                             '--- Ligne type de tiret
                        .Format.Line.Weight = rCode.Offset(0, 10)                               '--- Largeur du trait
                        .Format.Line.ForeColor.RGB = rCode.Offset(0, 9).Interior.Color          '--- Couleur trait
                    End With
                End If
            Next
            
    End With
    Set rCode = Nothing
End Sub

Peut-être en ajoutant un If mais je ne voudrais pas alourdir le code.

27/04/2020, 19h27
EricDgn
Bonjour,

Si j'ai bien compris, vous voulez masquer certains marqueurs et certains traits (attention à ne pas faire les 2 en même temps comme pour C).
Pour les marqueurs, c'est un "style" (comme carré, losange, etc.). Consultez l'Aide pour MarkerStyle.
Pour les traits, c'est la propriété Visible qui gère cela.
Code:

1 2 .MarkerStyle = xlMarkerStyleNone ' = -4142 .Format.Line.Visible = msoFalse
Cordialement.

Code finalisé

Bonjour,

Merci pour ces informations complémentaires. J'ai vraiment du mal avec les "Styles" quand on consulte l'aide pour XlMarkerStyle. L'énumération me donne par exemple pour xlMarkerStyleX une valeur de "-4168" tandis que moi je lui attribue une valeur de "4" et ça donne le même résultat.

Finalement j'ai fait comme je connais avec des If pour un résultat qui me satisafait. Voici le code finalisé si d'autres sont intéressés.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Sub MiseEnForme() '--- Mise en forme du graphique
 
    Dim mySrs As Series
    Dim sC As String, kR As Long, kC As Long
    Dim sCode As String, rCode As Range
 
    With ActiveSheet.ChartObjects("Graphique 8").Activate
 
             For Each mySrs In ActiveChart.SeriesCollection
                '--- Position légende (titre) de la série
                sC = mySrs.Formula                      '--- Formule de la série
                sC = Mid(sC, 9, InStr(sC, ",") - 9)     '--- Adresse de la légende
                kR = Range(sC).Row
                kC = Range(sC).Column
 
                sCode = Cells(kR - 1, kC)   '--- Le "code" est au dessus de la légende (en ligne)
 
                '--- Modification de la série
                If sCode = "" Then
                    '--- Ne rien changer à la série si vide
                Else
                    Set rCode = Sheets("MForme").Range("A3:A28")    '--- Plage des codes
                    Set rCode = rCode.Find(sCode)                   '--- Recherche des correspondances
 
                        If rCode Is Nothing Then
                            MsgBox "Ce code " & sCode & " ne figure pas dans la liste des codes."
                            Exit Sub
                        End If
 
                    With mySrs
                        If rCode.Offset(0, 1) = "non" Then
                            Else
                                .MarkerStyle = rCode.Offset(0, 2)                                       '--- Type de marker
                                .MarkerBackgroundColor = rCode.Offset(0, 3).Interior.Color              '--- Couleur remplissage marker
                                .MarkerForegroundColor = rCode.Offset(0, 4).Interior.Color              '--- Couleur contour marker
                                .MarkerSize = rCode.Offset(0, 5)                                        '--- Taille du marker
                        End If
                        If rCode.Offset(0, 6) = "non" Then
                            Else
                                .Format.Line.Style = rCode.Offset(0, 7)                                 '--- Ligne composition
                                .Format.Line.DashStyle = rCode.Offset(0, 8)                             '--- Ligne type de tiret
                                .Format.Line.ForeColor.RGB = rCode.Offset(0, 9).Interior.Color          '--- Couleur trait
                                .Format.Line.Weight = rCode.Offset(0, 10)                               '--- Largeur du trait
                        End If
                    End With
                End If
            Next
 
    End With
    Set rCode = Nothing
End Sub

28/04/2020, 10h32
EricDgn

Oui, passer par des If est sans doute la solution la plus simple.

Maintenant, comme pour le cas If "non" il n'est rien prévu, il faudrait vérifier que quand on change le code d'une série qui était initialement avec "oui" à un code avec "non", il s'effectue bien le changement prévu. Je pense que cela laisse l'ancien en place.

Cordialement.

Citation:

Envoyé par EricDgn

Oui, passer par des If est sans doute la solution la plus simple.

Maintenant, comme pour le cas If "non" il n'est rien prévu, il faudrait vérifier que quand on change le code d'une série qui était initialement avec "oui" à un code avec "non", il s'effectue bien le changement prévu. Je pense que cela laisse l'ancien en place.

Cordialement.

Vous avez l'oeil ! Effectivement ça pose problème. Donc pour y remédier 'ai ajouté ceci :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
With mySrs
                        If rCode.Offset(0, 1) = "non" Then
                            .MarkerStyle = xlMarkerStyleNone
                            Else
                                .MarkerStyle = rCode.Offset(0, 2)                                       '--- Type de marker
                                .MarkerBackgroundColor = rCode.Offset(0, 3).Interior.Color              '--- Couleur remplissage marker
                                .MarkerForegroundColor = rCode.Offset(0, 4).Interior.Color              '--- Couleur contour marker
                                .MarkerSize = rCode.Offset(0, 5)                                        '--- Taille du marker
                        End If
                        If rCode.Offset(0, 6) = "non" Then
                            .Format.Line.Visible = msoFalse
                            Else
                                .Format.Line.Visible = msoTrue
                                .Format.Line.Style = rCode.Offset(0, 7)                                 '--- Ligne composition
                                .Format.Line.DashStyle = rCode.Offset(0, 8)                             '--- Ligne type de tiret
                                .Format.Line.ForeColor.RGB = rCode.Offset(0, 9).Interior.Color          '--- Couleur trait
                                .Format.Line.Weight = rCode.Offset(0, 10)                               '--- Largeur du trait
                        End If

Merci, cordialement.