Discussion :

[G57HELP]

Bonjour à tous,

Débutant en VBA, je sollicicite le forum pour me venir svp en aide. J'ai reussi à adapter un code pour créer des graphique (1 par onglet/ = 1client). Seulement je n'arrive pas à modifier les abscisses, en sachant que les données en abscisses sont strictement les mêmes pour tous les graph. De plus, je n'arrive pas à modifier le nom des séries de données de chaque graph.
Je remercie d'avance ce qui se pencheront sur ma demande.

Un fichier en PJ (Voir Feuil1)

-Exemple GraphVBA_Test.xlsmG57HELP-

[Invité]

La présentation de vos données pourrait être optimisée. Un exemple de ce que vous pourriez faire :

Pièce jointe 314089

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
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
 
Option Explicit
 
Sub CreationOuMiseAJourDesGraphes()
 
Dim ShSites As Worksheet, ShEnCours As Worksheet
Dim TableauSites As ListObject
Dim AireDesSites As Range, TitreDesSites As Range, AireEncours As Range
Dim CreationOnglet As Boolean
Dim I As Integer, LigneDeTitre As Long, PremiereColonneTitre As Integer, DerniereColonneTitre As Integer, LigneEnCours As Integer
 
    Set ShSites = Sheets("Données des sites")
    With ShSites
 
         Set TableauSites = .ListObjects("TableauDesSites")
         With TableauSites
             LigneDeTitre = .HeaderRowRange.Row
             PremiereColonneTitre = .ListColumns(2).Range.Column
             DerniereColonneTitre = .ListColumns(.ListColumns.Count).Range.Column
         End With
 
         Set TitreDesSites = Range(.Cells(LigneDeTitre, PremiereColonneTitre), .Cells(LigneDeTitre, DerniereColonneTitre))
 
         With TableauSites
              Set AireDesSites = .ListColumns(1).DataBodyRange
              For I = 1 To AireDesSites.Count
                  CreationOnglet = True
                  LigneEnCours = AireDesSites(I).Row
                  Set AireEncours = Range(ShSites.Cells(LigneEnCours, PremiereColonneTitre), ShSites.Cells(LigneEnCours, DerniereColonneTitre))
                  For Each ShEnCours In Sheets
                      If ShEnCours.Name = AireDesSites(I) Then CreationOnglet = False
                  Next ShEnCours
 
                  If CreationOnglet = True Then
                     Set ShEnCours = Sheets.Add(after:=Sheets(Sheets.Count))
                     With ShEnCours
                          .Name = AireDesSites(I)
                          CreerLeGraphe ShEnCours, ShSites, TitreDesSites, AireEncours, "Consommation", "Consommation annuelle"
                     End With
                     Set ShEnCours = Nothing
                  Else
                     Set ShEnCours = Sheets(AireDesSites(I).Value)
                     SupprimerLeGraphe ShEnCours, "Consommation"
                     CreerLeGraphe ShEnCours, ShSites, TitreDesSites, AireEncours, "Consommation", "Consommation annuelle"
                     Set ShEnCours = Nothing
 
                  End If
                  Set AireEncours = Nothing
              Next I
              Set AireDesSites = Nothing
              Set TitreDesSites = Nothing
         End With
         .Activate
    End With
 
    MsgBox "Fin de création ou de mise à jour des graphes", vbInformation
 
    Set TableauSites = Nothing
    Set ShSites = Nothing
 
End Sub
 
 
Sub CreerLeGraphe(ByVal FeuilleGraphe As Worksheet, ByVal FeuilleSource As Worksheet, ByVal DonneesTitre As Range, ByVal DonneesSerie As Range, ByVal NomDuGraphe As String, ByVal LegendeDuGraphe As String) ', ByVal TitreGraphe As String)
 
Dim MonChartObject As ChartObject
Dim MonGraphique As Chart
Dim Serie1 As Series
Dim CelluleDestination As Range
 
   With FeuilleGraphe
 
        Set CelluleDestination = .Range("H5")
        Set MonChartObject = .ChartObjects.Add(CelluleDestination.Left, CelluleDestination.Top, 400, 300)
        MonChartObject.Name = NomDuGraphe
        With MonChartObject.Chart
 
             .ChartType = xlLine
             .HasTitle = True
             .ChartTitle.Text = FeuilleGraphe.Name
 
             Set Serie1 = .SeriesCollection.NewSeries
             With Serie1
                  .Name = LegendeDuGraphe
                  .Values = "'" & FeuilleSource.Name & "'!" & DonneesSerie.Address
                  .XValues = "'" & FeuilleSource.Name & "'!" & DonneesTitre.Address
             End With
             Set Serie1 = Nothing
        End With
        Set MonChartObject = Nothing
   End With
 
End Sub
 
 
Sub SupprimerLeGraphe(ByVal FeuilleGraphe As Worksheet, ByVal NomDuGraphe As String)
 
Dim MonChartObject As ChartObject
 
   With FeuilleGraphe
        For Each MonChartObject In .ChartObjects
            If MonChartObject.Name = NomDuGraphe Then MonChartObject.Delete
        Next MonChartObject
   End With
 
End Sub

Accessoirement :

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
 
Sub SuprimerLesOnglets()
 
Dim ShSites As Worksheet, ShEnCours As Worksheet
Dim TableauSites As ListObject
Dim AireDesSites As Range
Dim I As Integer
 
    Set ShSites = Sheets("Données des sites")
    With ShSites
         Set TableauSites = .ListObjects("TableauDesSites")
         With TableauSites
              Set AireDesSites = .ListColumns(1).DataBodyRange
              For I = 1 To AireDesSites.Count
                  For Each ShEnCours In Sheets
                      If ShEnCours.Name = AireDesSites(I) Then
                         Application.DisplayAlerts = False
                         ShEnCours.Delete
                         Application.DisplayAlerts = True
                      End If
                  Next ShEnCours
              Next I
              Set AireDesSites = Nothing
         End With
         .Activate
    End With
 
    MsgBox "Fin de suppression des onglets !", vbInformation
 
    Set TableauSites = Nothing
    Set ShSites = Nothing
 
End Sub

[G57HELP]

bjr,

un grand merci Eric KERGRESSE, je ne m'attendais pas a quelquechose d'aussi aboutie.

Bonne journée
A+