VBA pour gestion graphique

Version imprimable

Bonjour
Au sein d'une boucle VBA, je crée un graphique correspondant à un tableau de valeurs mis à jour par la boucle dans une feuille "Selection". Ce grahique est du type radar, avec plusieurs séries de données correctement créées. Je souhaite mettre ce graphe dans une feuille "Trame" à un emplacement précis et une taille précise. La feuille Trame contient déjà des informations dans d'autres cellules : elle est ensuite sauvegardée en pdf puis doit être effacée pour le prochain traitement. J'ai enlevé les tous les formattages pour plus de clarté et fait une boucle rudimentaire avec deux passages (Index étant l'index de boucle).
J'ai effectué l'opération manuellement et elle se déroule bien mais le code ci-joint ne veut pas fonctionner. L'enregistreur de Macros ne permet pas de placer le graphique créé sur une feuille de calcul de manière explicite.
Quelqu'un aurait une idée, la macro est ci-dessous :

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
 
Sub TraceTest()
Dim feuilleData, feuilleTrame As Worksheet
Dim Emplacement As Range
Dim i, Index, NbFiches, NbPoints As Integer
Dim NomFichier As String
    Set feuilleData = ActiveWorkbook.Sheets("Selection")
    Set feuilleTrame = ActiveWorkbook.Sheets("Trame")
    NbFiches = 2                ' nombre de passages dans la boucel
    NbPoints = 8                ' nombre de points par série
For Index = 1 To NbFiches
'---------------------------------------------------------------------------------------------
' Calcul test des données à tracer
    For i = 1 To NbPoints
        feuilleData.Cells(2, i) = i / NbPoints
        feuilleData.Cells(3, i) = Index
    Next i
'---------------------------------------------------------------------------------------------
' intialisation de la feuille de destination
    feuilleTrame.Activate
    feuilleTrame.Cells(1, 4) = "Numéro : "
    feuilleTrame.Cells(1, 5) = Index
'---------------------------------------------------------------------------------------------
' création du graphique
    Charts.Add
    With ActiveChart
        .ChartType = xlRadarMarkers
        .Name = "RadarTest"
        .SetSourceData Source:=Sheets("Selection").Range("A1:H1,A2:H2,A3:H3"), PlotBy:=xlRows
        .FullSeriesCollection(1).Name = "=""année 1"""      ' série 1
        .FullSeriesCollection(2).Name = "=""année 2"""      ' série 2
    End With
'----------------------------------------------------------------------------------------------
' emplacement
    ActiveChart.Location Where:=xlLocationAsObject, Name:="Trame"  ' position du tracé
    feuilleTrame.Activate
    Set Emplacement = Range("A9:H28")       ' emplacement où doit arriver le graphique sur Trame
    With ActiveSheet.ChartObjects(1)
        .Left = Emplacement.Left
        .Top = Emplacement.Top
        .Height = Emplacement.Height
        .Width = Emplacement.Width
    End With
'----------------------------------------------------------------------------------------------
' enregistrement
    NomFichier = "D:\Export\FichierTest" & Index
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=NomFichier & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False
'----------------------------------------------------------------------------------------------
' nettoyage
    ActiveChart.Delete
    feuilleTrame.Activate
    Cells.Select
    Selection.Delete Shift:=xlUp
 
Next Index
End Sub

Merci d'avance.

Bonjour,

Remplace cette partie du code :

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
' intialisation de la feuille de destination
    feuilleTrame.Activate
    feuilleTrame.Cells(1, 4) = "Numéro : "
    feuilleTrame.Cells(1, 5) = Index
'---------------------------------------------------------------------------------------------
' création du graphique
    Charts.Add
    With ActiveChart
        .ChartType = xlRadarMarkers
        .Name = "RadarTest"
        .SetSourceData Source:=Sheets("Selection").Range("A1:H1,A2:H2,A3:H3"), PlotBy:=xlRows
        .FullSeriesCollection(1).Name = "=""année 1"""      ' série 1
        .FullSeriesCollection(2).Name = "=""année 2"""      ' série 2
    End With
'----------------------------------------------------------------------------------------------
' emplacement
    ActiveChart.Location Where:=xlLocationAsObject, Name:="Trame"  ' position du tracé
    feuilleTrame.Activate
    Set Emplacement = Range("A9:H28")       ' emplacement où doit arriver le graphique sur Trame
    With ActiveSheet.ChartObjects(1)
        .Left = Emplacement.Left
        .Top = Emplacement.Top
        .Height = Emplacement.Height
        .Width = Emplacement.Width
    End With

par ce code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
 
     Dim MonGraph As Shape 'place ce dimensionnement de variable avec les autres en début de code
    Set feuilleTrame = ActiveWorkbook.Sheets("Trame")
    With feuilleTrame
        .Cells(1, 4).Value = "Numéro : "
        .Cells(1, 5).Value = MonIndex ' remplace index par autre chose par exemple "MonIndex" car index est un nom reservé VBA donc risque de conflit !
        Set Emplacement = .Range("A9:H28")
        Set MonGraph = .Shapes.AddChart2(XlChartType:=xlRadarMarkers, Left:=Emplacement.Left, Top:=Emplacement.Top, Height:=Emplacement.Height, Width:=Emplacement.Width)
        .ChartObjects(1).Name = "RadarTest"
    End With
    With MonGraph.Chart
        .SetSourceData Source:=Range("Selection!$A$1:$H$3"), PlotBy:=xlRows 
        .FullSeriesCollection(1).Name = "=""année 1"""      ' série 1
        .FullSeriesCollection(2).Name = "=""année 2"""      ' série 2
        .FullSeriesCollection(3).Name = "=""année 3"""      ' série 3
    End With
End Sub

Edit : amelioration du code de remplacement avec un select en moins ce qui fait plus propre ;)

Merci Phil pour ta réponse. J'ai bien remplacé le code mais, en mode pas à pas, j'obtiens une erreur 1004 et pas d'exécution de la ligne 32 "Set MonGraph..." : aurais-je oublié qq chose ?
Merci pour ton aide.

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
 
Option Explicit
Sub TrTest2()
Dim feuilleData, fTr As Worksheet
Dim Emplacement As Range
Dim i, Index, NbFiches, NbPoints As Integer
Dim NomFichier As String
Dim MonGraph As Shape
 
Set feuilleData = ActiveWorkbook.Sheets("Selection")
    Set fTr = ActiveWorkbook.Sheets("Trame")
    NbFiches = 2                ' nombre de passages dans la boucel
    NbPoints = 8                ' nombre de points par série
For Index = 1 To NbFiches
'---------------------------------------------------------------------------------------------
' Calcul test des données à tracer
    For i = 1 To NbPoints
        feuilleData.Cells(2, i) = i / NbPoints
        feuilleData.Cells(3, i) = Index
    Next i
'---------------------------------------------------------------------------------------------
' intialisation de la feuille de destination
    fTr.Activate
    Cells.Select
    Selection.Delete Shift:=xlUp
'----------------------------------------------------------------------------------------------
' emplacement
    With fTr
        .Cells(1, 4) = "Numéro : "
        .Cells(1, 5) = Index
        Set Emplacement = .Range("A9:H28")       ' emplacement où doit arriver le graphique sur Trame
        Set MonGraph = .Shapes.AddChart2(XlChartType:=xlRadarMarkers, Left:=Emplacement.Left, Top:=Emplacement.Top, Height:=Emplacement.Height, Width:=Emplacement.Width)
        .ChartObjects(1).Name = "RadarTest"
    End With
    With MonGraph.Chart
        .SetSourceData Source:=Range("Selection!$A$1:$H$3"), PlotBy:=xlRows
        .FullSeriesCollection(1).Name = "=""année 1"""      ' série 1
        .FullSeriesCollection(2).Name = "=""année 2"""      ' série 2
    End With
'----------------------------------------------------------------------------------------------
' enregistrement
    NomFichier = "D:\Export\FichierTest" & Index
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=NomFichier & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False
 
Next Index
End Sub