Discussion :

[Ramses38]

Bonjour,

J'ai une série de graphiques avec à chaque fois au moins une quinzaine de courbes et j'aimerai pouvoir afficher/masquer sélectivement une ou plusieurs séries pour plus de clarté. En parcourant les divers forums, j'ai trouvé une méthode assez simple avec l'emploi d'une checkbox qui renvoie dans un tableau secondaire les valeurs initiales de la série ou aucune valeur, masquant ainsi la série sur le graphique. Malheureusement, c'est une méthode fastidieuse, lourde et incomplète.
Mon idée à la base était de pouvoir sélectionner alternativement une ou plusieurs série en cliquant simplement sur l'entête de la série (sorte de bouton), mettant en surbrillance cette cellule quand la série est active.
Il doit sûrement exister des lignes de codes VBA effectuant cette tache mais j'avoue que cela me dépasse.

Ainsi pourriez-vous m'aider à améliorer mon graphique :
- méthode directe évitant la création d'un tableau secondaire
- remplacer la checkbox par une "activation" de cellule
- légende dynamique qui n'affiche que les séries actives
- fixer la couleur et marqueur d'une série en fonction du nom de celle-ci.

En pièce jointe, mon ébauche de graphique.

Merci d'avance pour vos réponses

[jfontaine]

Bonjour,

Ci dessous une proposition en utilisant l'évenement SelectionChange de la Feuille.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Dim Rg As Range
Dim Myserie As Series
Dim Bol As Boolean
 
Bol = False
 
 
For Each Rg In Target
    If Not Intersect(Range("B1:Q1"), Rg) Is Nothing Then
           Me.ChartObjects("Graphique 17").Select
           If Bol = False Then
                For Each Myserie In ActiveChart.SeriesCollection
                    Myserie.Delete
                Next Myserie
                Bol = True
            End If
        Set Myserie = ActiveChart.SeriesCollection.NewSeries
        Myserie.XValues = "=Feuil1!R2C1:R13C1"
        Myserie.Values = "=Feuil1!R2C" & Rg.Column & ":R13C" & Rg.Column
        Myserie.Name = "=Feuil1!R1C" & Rg.Column
 
    End If
Next Rg
 
Target.Select
 
 
End Sub

VBA - Manipulation Chart.xls

[Ramses38]

Je vous remercie pour votre proposition, c'est presque ce que je recherchais. Malheureusement, dès que je sélectionne une série le code plante à la ligne suivante :
Myserie.Name = "=Feuil1!R1C" & Rg.Column

Sinon, si ce n'est trop vous demander, pourriez-vous m'indiquer comment réutiliser votre méthode pour d'autres graphs, j'ai découvert seulement il y a peu le VBA d'excel.

Cordialement,
Jean

[jfontaine]

Malheureusement, dès que je sélectionne une série le code plante à la ligne suivante :
Myserie.Name = "=Feuil1!R1C" & Rg.Column

Ca plante sur mon fichier ou dans ton code?
Si dans ton code le titre se trouve t'il dans la plage B1 à Q1?

Sinon, si ce n'est trop vous demander, pourriez-vous m'indiquer comment réutiliser votre méthode pour d'autres graphs, j'ai découvert seulement il y a peu le VBA d'excel.

Si plusieurs graphiques sur la même feuille, ajouter autant de bloc que de graphiques

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
For Each Rg In Target
    If Not Intersect(Range("B1:Q1"), Rg) Is Nothing Then
           Me.ChartObjects("Graphique 17").Select
           If Bol = False Then
                For Each Myserie In ActiveChart.SeriesCollection
                    Myserie.Delete
                Next Myserie
                Bol = True
            End If
        Set Myserie = ActiveChart.SeriesCollection.NewSeries
        Myserie.XValues = "=Feuil1!R2C1:R13C1"
        Myserie.Values = "=Feuil1!R2C" & Rg.Column & ":R13C" & Rg.Column
        Myserie.Name = "=Feuil1!R1C" & Rg.Column
     End If
   'Bloc pour graphique 2
    If Not Intersect(Range("B40:Q40"), Rg) Is Nothing Then
           Me.ChartObjects("Graphique 18").Select
           If Bol2 = False Then
                For Each Myserie In ActiveChart.SeriesCollection
                    Myserie.Delete
                Next Myserie
                Bol2 = True
            End If
        Set Myserie = ActiveChart.SeriesCollection.NewSeries
        Myserie.XValues = "=Feuil1!R41C1:R53C1"
        Myserie.Values = "=Feuil1!R41C" & Rg.Column & ":R53C" & Rg.Column
        Myserie.Name = "=Feuil1!R40C" & Rg.Column
     End If
Next Rg

[Ramses38]

Ca plante sur mon fichier ou dans ton code?
Si dans ton code le titre se trouve t'il dans la plage B1 à Q1?

Ca plante dans votre fichier et dans mon code également, toujours à la même ligne. Problème de référencement ?
Merci pour les autres graphs.

[jfontaine]

Ca plante dans votre fichier

pas de problème sur mon poste.

[Ramses38]

Re-bonjour,

Je ne comprend pas, votre code marche très bien sauf pour l'attribution du nom de série :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Myserie.Name = "=Feuil1!R1C" & Rg.Column

Dès que je rajoute cette ligne, ça plante, que ce soit dans votre xls original que sur un autre. Auriez-vous une solution ?

Autre chose, serait-il possible également de fixer le style (couleur/marqueur) pour chaque série en fonction de son nom ? Par exemple, une sorte de vecteur [style] contenant les infos pour chaque série.
Pour l'instant, je n'ai trouvé qu'une macro, qui définie un style pour chaque série, mais pour un graph "statique" seulement.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub CouleurSeries()Dim MesSeries As SeriesWith ActiveChart
 
For Each MesSeries In .SeriesCollectionSelect Case MesSeries.Name
 
Case "Serie 1"MesSeries.Border.ColorIndex = 46MesSeries.Border.Weight = xlThickMesSeries.MarkerStyle = xlMarkerStyleSquareMesSeries.MarkerBackgroundColorIndex = 46MesSeries.MarkerForegroundColorIndex = 46MesSeries.MarkerSize = 10End SelectNext
 
End WithEnd Sub

Cordialement,

Jean

[jfontaine]

Pour le problème de nom essais comme cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Myserie. Name = "=" & Me.Name & "!" & Rg.Address(ReferenceStyle:=xlR1C1)

Pour gérer le style et la couleur de chaque courbe, ci dessous une proposition sur les colonnes Fe et Ti

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
Dim Rg As Range
Dim Myserie As Series
Dim Bol As Boolean
 
Bol = False
 
 
For Each Rg In Target
    If Not Intersect(Range("B1:Q1"), Rg) Is Nothing Then
           Me.ChartObjects("Graphique 17").Select
           If Bol = False Then
                For Each Myserie In ActiveChart.SeriesCollection
                    Myserie.Delete
                Next Myserie
                Bol = True
            End If
        Set Myserie = ActiveChart.SeriesCollection.NewSeries
        With Myserie
            .XValues = "=Feuil1!R2C1:R13C1"
            .Values = "=Feuil1!R2C" & Rg.Column & ":R13C" & Rg.Column
            .Name = "=" & Me.Name & "!" & Rg.Address(ReferenceStyle:=xlR1C1)
            'Mise en Forme
            Select Case Rg.Value
                Case "[Fe]"
                    .Border.ColorIndex = 9
                    .Border.Weight = xlMedium
                    .Border.LineStyle = xlContinuous
                Case "[Ti]"
                    .Border.ColorIndex = 10
                    .Border.Weight = xlMedium
                    .Border.LineStyle = xlContinuous
            End Select
 
        End With
    End If
Next Rg
 
Target.Select
 
 
End Sub

[Ramses38]

Bonjour,

Je vous remercie encore pour votre code qui m'aide grandement dans mes représentations graphiques, malheureusement celui-ci n'est pas encore au point.
Premièrement, le code ne veut toujours pas prendre en compte le nom des séries :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Myserie.Name = "=Feuil1!R1C" & Rg.Column

J'ai beau eu chercher des solutions alternatives, rien ne marche.

Ensuite, comment changer le système de référence de cellule (RxCy en XY) car mes plages de données de mes graphiques sont situées assez loin colonne GE) donc difficile de connaitre l'indice pour un référencement en RxCy.

Autre chose, j'ai constaté que chaque sélection de colonne ajoute une nouvelle série, même si déjà existante. Serait-il possible de pouvoir supprimer la série en "re-cliquant" simplement sur la colonne ? (genre de boucle qui vérifie si la série est déjà présente...)

En dernier lieu, je voulais que la couleur des séries soit conditionnée par leur nom. J'ai trouvé cette macro qui colore chaque série en fonction de de la couleur de remplissage de la première cellule de donnée :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub CellColorsToChart()
Dim oChart As ChartObject
Dim MySeries As Series
Dim FormulaSplit As Variant
Dim SourceRange As Range
Dim SourceRangeColor As Long
 
'Loop through all charts in the active sheet
For Each oChart In ActiveSheet.ChartObjects
 
    'Loop through all series in the target chart
    For Each MySeries In oChart.Chart.SeriesCollection
 
        'Get Source Data Range for the target series
        FormulaSplit = Split(MySeries.Formula, ",")
 
        'Capture the first cell in the source range then trap the color
        Set SourceRange = Range(FormulaSplit(2)).Item(1)
        SourceRangeColor = SourceRange.Interior.Color
 
        'Coloring for Excel 2007 and 2010
        MySeries.MarkerBackgroundColor = SourceRangeColor
        MySeries.MarkerForegroundColor = SourceRangeColor
        MySeries.Format.Line.ForeColor.RGB = SourceRangeColor
        MySeries.Format.Line.BackColor.RGB = SourceRangeColor
        MySeries.Format.Fill.ForeColor.RGB = SourceRangeColor
 
    Next MySeries
Next oChart
 
End Sub

Serait-il possible de modifier cette macro pour qu'elle prenne l'en-tête des colonnes au lieu de la première ligne de donnée.

Également, pourrait-on l'intégrer à votre code pour éviter la remise en forme ultérieure ?

Ci-joint, mes dernières modifs.

Cordialement,

Jean