Création automatique de graphe en VBA

Version imprimable

3 pièce(s) jointe(s)

Bonjour,

Je souhaite créer une macro VBA permettant de générer automatiquement des graphes a partir d'un tableau Excel provenant d'une feuille X sur une feuille Y

Les données sources sont stockées de cette façon :
Pièce jointe 280958

je souhaite créer des graphes dont le titre comprendra le libelle des "sous tableaux" (actuellement "libelleX") l'axe des abscisse comprenant les mois, pour l'axe des ordonnées comprenant des valeurs de 70% à 100% pour ensuite lier au graphe les 3 régions, leur moyenne ainsi qu'une droite étant la cible (toujours la même valeur)

Pour l'instant mon code fonctionnel est celui ci :

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
52
53
54
55
56
 
Sub GenerationGraphiques()
Dim flsource As Excel.Worksheet, fldest As Excel.Worksheet
Dim flThisLigTitre As Long
 
Dim Graphique As Chart, hautergraphe As Long, largeurgraphe As Long, intervale As Long
Dim topDistance As Long, leftDistance As Long
ThisWorkbook.Activate
Sheets("feuilSource").Select
Set flsource = Worksheets("feuilSource")
derLig = Split(flsource.UsedRange.Address, "$")(4)   'Récupère la dernière ligne utilisée de la page
intervale = 50
topDistance = 0
leftDistance = 0
hauteurgraphe = 250
largeurgraphe = 400
 
 
For flThisLigTitre = 9 To derLig
    If (flsource.Cells(flThisLigTitre, 1) <> "") Then
        Sheets("feuilDest").Select
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.ChartType = xlLine
        ActiveChart.SetSourceData Source:=Sheets("feuilSource").Range("A9:N13")
        ActiveChart.SeriesCollection(1).XValues = "='feuilSource'!C9:N9"
        ActiveChart.SeriesCollection(2).Values = "='feuilSource'!C11:N11"
        ActiveChart.SeriesCollection(3).Values = "='feuilSource'!C12:N12"
        ActiveChart.SeriesCollection(4).Values = "='feuilSource'!C13:N13"
        ActiveChart.Axes(xlValue).MaximumScale = 1
        ActiveChart.Axes(xlValue).MinimumScale = 0.7
        'Ajout d'un titre
        ActiveChart.HasTitle = True
       With ActiveChart.ChartTitle
            .Characters.Font.Italic = True
            .Characters.Font.Size = 11
            .Text = Cells(flThisLigTitre, 1).Value
        End With
        'Definition de la taille et de l'emplacement du graphe
        With ActiveChart.Parent
            If leftDistance = 50 Then
                leftDistance = leftDistance + largeurgraphe + intervale
                .Top = topDistance
                .Left = leftDistance
            Else
                leftDistance = 50
                topDistance = topDistance + hauteurgraphe + intervale
                .Top = topDistance
                .Left = leftDistance
           End If
                .Width = 400
                .Height = 250
        End With
    End If
    flThisLigTitre = flThisLigTitre + 4
Next
End Sub

Les problèmes que j'ai avec ce code :

le graphe est toujours le même car je n'arrive pas à mettre ces cellules en variables

Code:

1
2
3
4
5
6
 
        ActiveChart.SetSourceData Source:=Sheets("feuilSource").Range("A9:N13")
        ActiveChart.SeriesCollection(1).XValues = "='feuilSource'!C9:N9"
        ActiveChart.SeriesCollection(2).Values = "='feuilSource'!C11:N11"
        ActiveChart.SeriesCollection(3).Values = "='feuilSource'!C12:N12"
        ActiveChart.SeriesCollection(4).Values = "='feuilSource'!C13:N13"

Le titre des graphes ne s'affiche pas
je ne sais pas comment ajouter la valeur cible
les valeurs en ordonnées sont en numérique (0.7 à 1) et non pas en pourcentage (70% à 100%)

voici le résultat de l’exécution

Pièce jointe 280964

J'ai bien essayer de modifier le code de cette façon

Code:

1
2
3
4
5
6
 
        ActiveChart.SetSourceData Source:=Sheets("feuilSource").Range("A" & flThisLigTitre & ": N" & flThisLigTitre & 4)
        ActiveChart.SeriesCollection(1).XValues = "='feuilSource'!C" & flThisLigTitre & ": N" & flThisLigTitre
        ActiveChart.SeriesCollection(2).Values = "='feuilSource'!C" & flThisLigTitre + 2 & ": N " & flThisLigTitre + 2
        ActiveChart.SeriesCollection(3).Values = "='feuilSource'!C" & flThisLigTitre + 3 & ": N " & flThisLigTitre + 3
        ActiveChart.SeriesCollection(4).Values = "='feuilSource'!C" & flThisLigTitre + 4 & ": N " & flThisLigTitre + 4

Mais j'obtient une erreur sur la ligne

Code:

1
2
 
        ActiveChart.SeriesCollection(2).Values = "='feuilSource'!C" & flThisLigTitre + 2 & ": N " & flThisLigTitre + 2

Pièce jointe 280969

Pouvez-vous regarder avec moi pour comprendre pourquoi j'ai cette erreur et pour la résoudre,

J'avoue que je ne me suis pas encore penché sur les autres soucis (cités plus haut) mais si vous savez m'aider ce sera vraiment gentil sinon je regarderais après avoir résolu ce problème.

Bonne journée/soirée à vous !
Un grand merci d'avoir lu mon message et un encore plus grand d'y répondre.

31/05/2017, 08h41
riaolle

Bonjour,
J'avais eu un problème similaire il y a quelques temps. Essaie ceci :

Code:

ActiveChart.SeriesCollection(2).Values = Sheets("feuilSource").Range("C" & flThisLigTitre + 2 & ": N " & flThisLigTitre + 2)

Je ne promets rien .... mais à essayer (et adapter les autres séries si ça marche ;) )

Citation:

je ne sais pas comment ajouter la valeur cible

Tu ajoutes encore une série prenant pour valeur 12 fois la cellule avec la valeur cible. Utilise l'enregistreur de macro pour voir comment mettre 12 fois la même valeur. A la main, quand tu renseignes la source de la série, tu cliques 12 fois sur la cellule en mettant un ";" entre 2.

Citation:

les valeurs en ordonnées sont en numérique (0.7 à 1) et non pas en pourcentage (70% à 100%)

Dans les propriétés de l'axe, tu peux choisir le format de la valeur sur les axes. Tu choisiras pourcentage. Pour obtenir le code associé : enregistreur de macro.

Citation:

Le titre des graphes ne s'affiche pas

Euh...là, je ne sais pas trop pourquoi ça ne marche pas. J'imagine que tu as utilisé l'enregistreur de macro pour obtenir le code que tu nous présentes ?

1 pièce(s) jointe(s)

Commençons par les bases :

Pour pouvoir créer un graphique il existe plusieurs moyens :

1er cas : La création

Code:

ThisWorkbook.Charts.Add

Cette méthode créer le graphique comme nouvelle feuille
2e cas : La sélection directe

Code:

ActiveSheet.Shapes.AddChart.Select

Qui permets cette fois de créer le graphique dans la feuille actuelle

Nous allons partir sur le 2e cas.

Avant de continuer nous allons affecter nos valeurs à des variables, celle-ci doivent être des Range :

Code:

1
2
3
4
5
Dim Plage As Range
With ActiveSheet
Set Plage = .Range("C1:N5")
Titre = .Range("A1").Text
'etc...

Ensuite créons le graphique, donnons lui un nom et un type :

Code:

1
2
3
4
5
6
7
.Shapes.AddChart.Select
 
        With ActiveChart
 
            .Parent.Name = "Graphique 1" 'on veut que excel utilise ce nom pour ce graphique
'/!\ Il ne s'agit pas du titre du graphique
            .ChartType = xlLine 'on veut ici un graphique type en ligne

Une fois fait rajoutons des données en x et en y :

Code:

1
2
3
4
5
6
            .SeriesCollection(1).XValues = Plage 'On ajoute les abscisses
 
            .SeriesCollection.NewSeries 'On dit à Excel qu'on souhaite ajouter des données
            .SeriesCollection(1).Name = T_Données 'On donne un nom à nos donnée
            .SeriesCollection(1).Values = Données 'On ajoute les données (tjrs au format Range)
'etc...

Si on souhaite modifier l'axe des ordonnées on procède ainsi :

Code:

1
2
3
            With .Axes(xlValue)
                'Ce que tu souhaites modifier
            End With

Si on veut ajouter un titre :

Code:

1
2
            .SetElement (msoElementChartTitleAboveChart) 'On ajoute un élément titre au graphique
            .ChartTitle.Text = Titre 'On donne un texte au titre

Et voila on obtient un petit graphique :mouarf:
Bien évidement il existe plein d'autre composants dont je m'abstiendrai d'évoquer les détails car existant en FAQ, cours, etc. partout sur le web

Toujours est-il qu'un bon départ pour ton cas, pourrait être ceci :

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
Sub Test()
 
Dim Plage As Range
Dim Moy As Range
Dim R1 As Range
Dim R2 As Range
Dim R3 As Range
Dim Titre As String
Dim der As Integer
Dim Graphique As Chart
 
j = 1
 
With ActiveSheet
 
    der = .Range("A" & Rows.Count).End(xlUp).Row
 
    For x = 1 To der - 4 Step 5
 
        Set Plage = .Range("C" & x & ":N" & x)
 
        MoyT = .Range("A" & x + 1).Text
        Set Moy = .Range("C" & x + 1 & ":N" & x + 1)
 
        R1T = .Range("A" & x + 2).Text
        Set R1 = .Range("C" & x + 2 & ":N" & x + 2)
 
        R2T = .Range("A" & x + 3).Text
        Set R2 = .Range("C" & x + 3 & ":N" & x + 3)
 
        R3T = .Range("A" & x + 4).Text
        Set R3 = .Range("C" & x + 4 & ":N" & x + 4)
 
        Titre = .Range("A" & x).Text
 
        .Shapes.AddChart.Select
 
        With ActiveChart
 
            .Parent.Name = "Graphique " & j
            j = j + 1
 
            .ChartType = xlLine
 
            .SeriesCollection.NewSeries
            .SeriesCollection(1).Name = MoyT
            .SeriesCollection(1).Values = Moy
 
            .SeriesCollection.NewSeries
            .SeriesCollection(2).Name = R1T
            .SeriesCollection(2).Values = R1
 
            .SeriesCollection.NewSeries
            .SeriesCollection(3).Name = R2T
            .SeriesCollection(3).Values = R2
 
            .SeriesCollection.NewSeries
            .SeriesCollection(4).Name = R3T
            .SeriesCollection(4).Values = R3
 
            .SeriesCollection(1).XValues = Plage
 
            With .Axes(xlValue)
                .MaximumScale = 1.005
                .MinimumScale = 0.7
                .TickLabels.NumberFormat = "0%"
            End With
 
            .SetElement (msoElementChartTitleAboveChart)
            .ChartTitle.Text = Titre
 
        End With
 
    Next x
 
End With
 
End Sub

Donnant ceci :
Pièce jointe 281098

Bien évidement je les ai bougé à la main après :mouarf:

Pour le reste je te laisse un peu chercher sachant que Riaolle (bonjour au passage :mrgreen:) t'as déjà donnée des pistes

31/05/2017, 11h32
Invité

Bonjour,
https://www.developpez.net/forums/d1...f/#post8364420