Créer graphique dans zone de graphique =>Feuille de type graphique déjà existante ! [Résolu]

[Vincent32]

Bonjour,

Je réalise un graphique selon ce 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
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Sub Graph() 'Graphique :
 
    Dim G1 As Chart
    Dim ws1 As Worksheet
    Dim PlageDonnees1 As Range
    Dim PlageX1 As Range
    Dim PlageY1 As Range
    Dim MaSerie1 As Series
    Dim Compteur1 As Long
    Dim Col1 As Long
    Dim Lig1 As Long
 
    Set ws1 = ThisWorkbook.Worksheets("Feuille de données du graphique")
 
    Lig1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row 'Recherche la dernière ligne contenant une donnée
    Col1 = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column - 1 'Recherche la dernière colonne contenant une donnée
 
    With ws1
        Set PlageDonnees1 = .Range(.Cells(1, 1), .Cells(Lig1, Col1)) ' Définition de la plage de données
    End With
    Set G1 = ThisWorkbook.Charts.Add 'Ajout d'une feuille MonGraphe au classeur
        G1.ChartArea.Clear 'Effacement des données du graphe
        G1.ChartType = xlXYScatter 'Définition du type de graphique (nuage de points)
    Set PlageX1 = PlageDonnees1.Columns(1)
    For Compteur1 = 1 To Col1
        Set PlageY1 = PlageX1.Offset(, Compteur1)
        Set MaSerie1 = G1.SeriesCollection.NewSeries
 
        With MaSerie1 'Formattage des séries de données
            .Values = PlageY1
            .XValues = PlageX1
            .Name = PlageDonnees1.Cells(1, 1).Offset(, Compteur1)
        End With
        With G1.Axes(xlCategory) 'axe des abscisses
            .HasTitle = True 'définition du titre des abscisses
            .AxisTitle.Characters.Text = "Nombre d'onde (cm-1)"
        End With
        With G1.Axes(xlValue) 'axe des  ordonnées
            .HasTitle = True 'définition du titre des ordonnées
            .AxisTitle.Characters.Text = "Absorbance (U.A.)"
        End With
    Next Compteur1
End Sub

Est il possible de le créer en lui donnant un nom de feuille de type graphique prédéfini ? (par exemple une feuille intitulée mon graphique).

Par ailleurs si cette feuille contient déjà un graphique lui dire de l'effacer :

structure de type

Code :

1
2
3
4
5
if Worsheet("mon graphique")<>"" then 'si graphique déjà créé sur la feuille mon graphique alors effacement du graphe
 
worsheet.clearcontent
 
end if

Je ne sais pas si ces lignes de codes sont correctes?

Merci d'avance pour votre aide

[ctac_]

Bonjour,

Essayer comme ça

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub MonGraphe()
    Dim G1 As Chart
    On Error Resume Next
        Set G1 = ThisWorkbook.Charts("mon graphique") 'verif
    On Error GoTo 0
    If Not G1 Is Nothing Then
        G1.ChartArea.Clear 'Effacement des données du graphe
    Else
        Set G1 = ThisWorkbook.Charts.Add 'Ajout d'une feuille mon graphique au classeur
        G1.Name = "mon graphique"
    End If
    Set G1 = Nothing
End Sub

Cordilement

ctac

[Vincent32]

En fait je n'arrive pas à adapter ton code => il me renvoie l'erreur suivante :

"Variable objet ou variable de bloc With non définie" avec les lignes situées sous ta partie de code surligné en jaune

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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
Sub Graph() 'Graphique :
 
    Dim G1 As Chart
    Dim ws1 As Worksheet
    Dim PlageDonnees1 As Range
    Dim PlageX1 As Range
    Dim PlageY1 As Range
    Dim MaSerie1 As Series
    Dim Compteur1 As Long
    Dim Col1 As Long
    Dim Lig1 As Long
    Set ws1 = ThisWorkbook.Worksheets("Feuille de données du graphique")
 
    Lig1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row 'Recherche la dernière ligne contenant une donnée
    Col1 = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column - 1 'Recherche la dernière colonne contenant une donnée
 
    Lig1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row 'Recherche la dernière ligne contenant une donnée
 
    ws1.[A1] = "Nombre d'onde (cm-1)"
    ws1.[A1].Characters(Start:=18, Length:=2).Font.Superscript = True
 
     Application.ScreenUpdating = False
 
    With ws1
        Set PlageDonnees1 = .Range(.Cells(1, 1), .Cells(Lig1, Col1)) ' Définition de la plage de données
    End With
 
    On Error Resume Next
        Set G1 = ThisWorkbook.Charts("mon graphique") 'verif
    On Error GoTo 0
    If Not G1 Is Nothing Then
        G1.ChartArea.Clear 'Effacement des données du graphe
    Else
        Set G1 = ThisWorkbook.Charts.Add 'Ajout d'une feuille mon graphique au classeur
        G1.Name = "mon graphique"
    End If
    Set G1 = Nothing
 
        G1.ChartType = xlXYScatter 'Définition du type de graphique (nuage de points)
    Set PlageX1 = PlageDonnees1.Columns(1)
    For Compteur1 = 1 To Col1
    Set PlageY1 = PlageX1.Offset(, Compteur1)
    Set MaSerie1 = G1.SeriesCollection.NewSeries
 
        With MaSerie1 'Formattage des séries de données
            .Values = PlageY1
            .XValues = PlageX1
            .Name = PlageDonnees1.Cells(1, 1).Offset(, Compteur1)
            .Border.ColorIndex = 1 'Noir
            .Border.Weight = xlHairline
            .Border.LineStyle = xlContinuous
            .MarkerBackgroundColorIndex = xlNone
            .MarkerForegroundColorIndex = xlNone
            .MarkerStyle = xlNone
            .Smooth = False
            .MarkerSize = 3
            .Shadow = True
        End With
 
        G1.HasLegend = False
        G1.HasTitle = False
        With G1.Axes(xlCategory) 'axe des abscisses
            .HasTitle = True 'définition du titre des abscisses
            .AxisTitle.Characters.Text = "Nombre d'onde (cm-1)"
            .AxisTitle.Font.ColorIndex = 3
            .AxisTitle.Characters(Start:=18, Length:=2).Font.Superscript = True
            .AxisTitle.Font.Name = "Arial"
            .AxisTitle.Font.FontStyle = "Gras"
            .AxisTitle.Font.Size = 12
            .HasMajorGridlines = True 'Grille principale activée
            .HasMinorGridlines = True 'Grille secondaire activée
            .MajorGridlines.Border.ColorIndex = 16 'couleur de la grille principale
            .MajorGridlines.Border.Weight = xlHairline 'taille du trait de la grille principale
            .MajorGridlines.Border.LineStyle = xlDash 'type de trait de la grille principale
            .MinorGridlines.Border.ColorIndex = 15 'couleur de la grille secondaire
            .MinorGridlines.Border.Weight = xlHairline 'taille du trait de la grille secondaire
            .MinorGridlines.Border.LineStyle = xlDot 'type de trait de la grille secondaire
            .MinimumScale = 400 'valeur minimale
            .MaximumScale = 4000 'valeur maximale
            .MinorUnit = 50 'unité secondaire
            .MajorUnit = 200 'unité principale
            .Crosses = xlMaximum 'ordonnée à gauche
            .ReversePlotOrder = True 'échelle en ordre inverse
            .ScaleType = xlLinear
            .DisplayUnit = xlNone
            .MajorTickMark = xlCross 'position des unités principales
            .MinorTickMark = xlInside 'position des unités secondaires
            .TickLabelPosition = xlNextToAxis 'position des étiquette de données
            With .Border 'couleur et taille de l'axe
                .ColorIndex = 3 'couleur rouge
                .Weight = xlThin 'épaisseur
                .LineStyle = xlContinuous 'type
            End With
            With .TickLabels.Font 'Formatage des étiquettes de données
                .Name = "Arial" 'Police
                .FontStyle = "Normal" 'formattage
                .Size = 10 'taille
                .Strikethrough = False 'barrée
                .Superscript = False 'exposant
                .Subscript = False 'indice
                .OutlineFont = False '
                .Shadow = False 'transparence
                .Underline = xlUnderlineStyleNone 'souligné
                .ColorIndex = 3 'couleur (3=Rouge)
                .Background = xlAutomatic 'couleur du fond
            End With
        End With
 
        With G1.Axes(xlValue) 'axe des  ordonnées
            .HasTitle = True 'définition du titre des ordonnées
            .AxisTitle.Characters.Text = "Absorbance (U.A.)"
            .AxisTitle.Font.ColorIndex = 3
            .AxisTitle.Font.Name = "Arial"
            .AxisTitle.Font.FontStyle = "Gras"
            .AxisTitle.Font.Size = 12
            .HasMajorGridlines = True
            .HasMinorGridlines = True
            .MajorGridlines.Border.ColorIndex = 16 'couleur de la grille principale
            .MajorGridlines.Border.Weight = xlHairline 'taille du trait de la grille principale
            .MajorGridlines.Border.LineStyle = xlDash 'type de trait de la grille principale
            .MinorGridlines.Border.ColorIndex = 15 'couleur de la grille secondaire
            .MinorGridlines.Border.Weight = xlHairline 'taille du trait de la grille secondaire
            .MinorGridlines.Border.LineStyle = xlDot 'type de trait de la grille secondaire
            .MinimumScale = 0 'valeur minimale
            .MaximumScale = 3.5 'valeur maximale
            .MinorUnit = 0.1 'unité secondaire
            .MajorUnit = 0.5 'unité principale
            .Crosses = xlCustom 'Défini à quelle valeur l'axe X coupe l'axe Y
            .CrossesAt = 0 'Défini à quelle valeur l'axe X coupe l'axe Y
            .ReversePlotOrder = False 'échelle en ordre inverse
            .ScaleType = xlLinear
            .DisplayUnit = xlNonne
            .MajorTickMark = xlCross 'position des unités principales
            .MinorTickMark = xlInside 'position des unités secondaires
            .TickLabelPosition = xlNextToAxis 'position des étiquette de données
            With .Border 'couleur et taille de l'axe
                .ColorIndex = 3 'couleur rouge
                .Weight = xlThin 'épaisseur
                .LineStyle = xlContinuous 'type
            End With
            With .TickLabels.Font 'Formatage des étiquettes de données
                .Name = "Arial" 'Police
                .FontStyle = "Normal" 'formattage
                .Size = 10 'taille
                .Strikethrough = False 'barrée
                .Superscript = False 'exposant
                .Subscript = False 'indice
                .OutlineFont = False '
                .Shadow = False 'transparence
                .Underline = xlUnderlineStyleNone 'souligné
                .ColorIndex = 3 'couleur (3=Rouge)
                .Background = xlAutomatic 'couleur du fond
            End With
        End With
    Next Compteur1
 
    For Each MaSerie1 In G1.SeriesCollection
        MaSerie1.FormulaR1C1Local = Replace(MaSerie1.FormulaR1C1Local, "L1C", "L2C")
    Next MaSerie1
 
     Application.ScreenUpdating = True
 
End Sub

[ctac_]

Bonjour,

Supprimer

Code :

Set G1 = Nothing

C'est pour liberer la mémoire a la fin quand on ne sert plus de la variable G1

Cordialement

ctac

[Vincent32]

Merci pour ton aide ctac_