Discussion :

[PaulG2B]

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 :



Merci pour vos éclairages.

Bonn journée.

[EricDgn]

Bonjour,

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

Code :

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

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.

[EricDgn]

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 :

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
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.

[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.

[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

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 ?

[EricDgn]

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

Code :

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

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

[PaulG2B]

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 :

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

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 :

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

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

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

Code :

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

.MarkerStyle = rCode.Offset(0, 2)

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