Graphiques - Pb avec .SeriesCollection.Values (renvoi du vide)

**popsmelove** · 03/07/2012, 15h07

Bonjour,

j'ai l'habitude d'utiliser le code vba suivant pour redimensionner les échelles de tous les graphiques d'un classeur Excel.

Malheureusement le code ne marche pas quand il s'agit d'une feuille graphique (quand l'emplacement du graphique est une nouvelle feuille)...? en effet quand on cherche a extraire les values des séries, le code nous renvoi du vide alors qu'il marche très bien pour un graphique contenu dans une feuille lambda.

Quelqu'un a t-il une idée de ce qui ne va pas dans mon code ?

Merci

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
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
Sub Graph_Scale_Update()
 
On Error GoTo msg
 
'Variables
Dim ValuesArray(), SeriesValues As Variant
Dim ValuesArrayY2(), SeriesValuesY2 As Variant
Dim minY, maxY, ecartY As Double
Dim minY2, maxY2, ecartY2 As Double
Dim z, w, Ctr, TotCtr As Integer
Dim zy2, Ctry2, TotCtry2 As Integer
Dim test, test2, testg As Boolean
 
'Comptage du nombre de feuilles du classeur
 w = ActiveWorkbook.Sheets.Count
 
 For j = 1 To w
    ActiveWorkbook.Sheets(j).Select
 
    'Comptage du nombre de graphiques de la feuille
    z = ActiveSheet.ChartObjects.Count
 
    'Alerte si pas de graphique
    If z <> 0 Then
        'bouclage des graphiques
        For i = 1 To z
            'Raz des variables graphiques
            test = False
            test2 = False
            SeriesValues = 0
            SeriesValuesY2 = 0
            TotCtr = 0
            TotCtry2 = 0
            Ctr = 0
            Ctry2 = 0
            ActiveSheet.ChartObjects(i).Select
            With ActiveSheet.ChartObjects(i).Chart
                'Récupération des valeurs de la série
                For Each X In .SeriesCollection
                    If .HasAxis(xlValue, xlSecondary) = True Then
                        On Error Resume Next
                        If X.AxisGroup = 1 Then
                            SeriesValues = X.Values
                            If test = True Then
                                ReDim Preserve ValuesArray(1 To TotCtr + UBound(SeriesValues))
                            Else
                                ReDim ValuesArray(1 To TotCtr + UBound(SeriesValues))
                            End If
 
                            For Ctr = 1 To UBound(SeriesValues)
                                If IsError(SeriesValues(Ctr)) = False Then
                                    ValuesArray(Ctr + TotCtr) = SeriesValues(Ctr)
                                End If
                            Next
                            TotCtr = TotCtr + UBound(SeriesValues)
                            test = True
                        End If
                        If X.AxisGroup = 2 Then
                            SeriesValuesY2 = X.Values
                            If test2 = True Then
                                ReDim Preserve ValuesArrayY2(1 To TotCtr + UBound(SeriesValuesY2))
                            Else
                                ReDim ValuesArrayY2(1 To TotCtr + UBound(SeriesValuesY2))
                            End If
                            For Ctry2 = 1 To UBound(SeriesValuesY2)
                                If IsError(SeriesValuesY2(Ctry2)) = False Then
                                    ValuesArrayY2(Ctry2 + TotCtry2) = SeriesValuesY2(Ctry2)
                                End If
                            Next
                            TotCtry2 = TotCtry2 + UBound(SeriesValuesY2)
                            test2 = True
                        End If
                    Else
                        On Error Resume Next
                        SeriesValues = X.Values
                        If test = True Then
                            ReDim Preserve ValuesArray(1 To TotCtr + UBound(SeriesValues))
                        Else
                            ReDim ValuesArray(1 To TotCtr + UBound(SeriesValues))
                        End If
 
                        For Ctr = 1 To UBound(SeriesValues)
                            If IsError(SeriesValues(Ctr)) = False Then
                                ValuesArray(Ctr + TotCtr) = SeriesValues(Ctr)
                            End If
                        Next
                        TotCtr = TotCtr + UBound(SeriesValues)
                        test = True
                    End If
 
 
                 Next
 
                 'Calcul de l'écart mini maxi de la série
                 'mini = Application.Min(ValuesArray)
                 'maxi = Application.Max(ValuesArray)
                 'ecart = maxi - mini
                 'Détermination de la nouvelle valeur mini fonction de l'écart
                 minY = Application.Min(ValuesArray) - (Application.Max(ValuesArray) - Application.Min(ValuesArray)) / 10
                 maxY = Application.Max(ValuesArray) + (Application.Max(ValuesArray) - Application.Min(ValuesArray)) / 10
                 If .HasAxis(xlValue, xlSecondary) = True Then
                    minY2 = Application.Min(ValuesArrayY2) - (Application.Max(ValuesArrayY2) - Application.Min(ValuesArrayY2)) / 10
                    maxY2 = Application.Max(ValuesArrayY2) + (Application.Max(ValuesArrayY2) - Application.Min(ValuesArrayY2)) / 10
                 End If
                 '(mini Mod 10 ^ (Len(ecart) - 1))
                If .HasAxis(xlValue, xlSecondary) = True Then
                    .Axes(xlValue, xlPrimary).MinimumScale = minY
                    .Axes(xlValue, xlPrimary).MaximumScale = maxY
                    .Axes(xlValue, xlPrimary).MinorUnit = (maxY - minY) / 5
                    .Axes(xlValue, xlPrimary).MajorUnit = (maxY - minY) / 5
                    .Axes(xlValue, xlPrimary).CrossesAt = minY
 
                    .Axes(xlValue, xlSecondary).MinimumScale = minY2
                    .Axes(xlValue, xlSecondary).MaximumScale = maxY2
                    .Axes(xlValue, xlSecondary).MinorUnit = (maxY2 - minY2) / 5
                    .Axes(xlValue, xlSecondary).MajorUnit = (maxY2 - minY2) / 5
                    .Axes(xlValue, xlSecondary).CrossesAt = minY2
                Else
                    .Axes(xlValue, xlPrimary).MinimumScale = minY
                    .Axes(xlValue, xlPrimary).MaximumScale = maxY
                    .Axes(xlValue, xlPrimary).MinorUnit = (maxY - minY) / 5
                    .Axes(xlValue, xlPrimary).MajorUnit = (maxY - minY) / 5
                    .Axes(xlValue, xlPrimary).CrossesAt = minY
                    End If
                End If
            End With
        Next i
    End If
Next j
Exit Sub
 
msg:
    MsgBox ("ERROR")
 
 
End Sub

**Daniel.C** · 03/07/2012, 17h36

Bonjour,

Je ne sais pas si j'ai bien compris... Je n'ai pas décortiqué ton code. Celui-ci renvoie un tableau des valeurs de la série :

Code :

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

1
2
3
    With ActiveChart
        tabl = .SeriesCollection(1).Values
    End With

**popsmelove** · 19/07/2012, 16h46

Bonjour,

en fait le pb c'est déplacé, si j'applique le code suivant

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Graph_test()
 
'Comptage du nombre de feuilles du classeur
 w = ActiveWorkbook.Sheets.Count
 
 For j = 1 To w
    ActiveWorkbook.Sheets(j).Select
 
    'Comptage du nombre de graphiques de la feuille
    z = ActiveSheet.ChartObjects.Count
    MsgBox ("feuille : " & j & " Nombre de graph :" & z)
 Next j
End Sub

le nombre de graphique est null si ma feuille est un graphique (en faisant clique droit sur un graphique et qu'on choisit emplacement nouvelle feuille), par contre il me retrouve bien les graphiques s'il s'agit d'une feuille habituelle...

Pour mieux comprendre je joins un fichier excel exemple, la macro a executer est Graph_test dans le modul 1

Merci d'avance pour votre aide

**popsmelove** · 23/07/2012, 09h53

J'ai simplifié le fichier pour qu'il ne reste qu'une seule macro à tester "Graph_Test".

Une fois lancer vous pourrez observer que pour la feuille 1 le script arrive à identifier 1 graphique, alors que pour la feuille "Graph2" il n'en trouve aucun ??

Peut être que ces feuilles "graphique" ont des propriétés qui leurs sont spécifiques ? pour l'instant je n'ai rien trouvé la dessus...

Merci

**Daniel.C** · 23/07/2012, 10h28

Bonjour,

L'objet "Sheet" comprend deux types de feuilles :
1. des feuilles de calcul (Worksheet) pouvant contenir des graphiques incorporés.
2. des feuilles de graphique contenant 1 graphique. on les distingue en testant le type de feuille :

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
Sub Graph_test()
 
 
'Comptage du nombre de feuilles du classeur
 w = ActiveWorkbook.Sheets.Count
 
 For j = 1 To w
    ActiveWorkbook.Sheets(j).Select
 
    'Comptage du nombre de graphiques de la feuille
    Set s = ActiveSheet
    'est-ce qu'il s'agit d'une feuille de graphique ?
    If Sheets(j).Type = 4 Then
        Z = 1
    Else
        Z = ActiveSheet.ChartObjects.Count
    End If
    MsgBox (Sheets(j).Name & " : Nombre de graph :" & Z)
 Next j
End Sub

**popsmelove** · 23/07/2012, 10h42

A génial, merci pour ton aide Daniel.

Je ne sais même pas pourquoi je n'ai pas pensé au type de la feuille, j'étais tellement accaparé par l'objet graphique...

Graphiques - Pb avec .SeriesCollection.Values (renvoi du vide) [XL-2003]

Macros et VBA Excel

Discussions similaires

Partager

Partager