Précédent   Forum des professionnels en informatique > Logiciels > Microsoft Office > Excel > Macros et VBA Excel
Macros et VBA Excel Vos questions relatives aux macros Excel, à l'utilisation de VBA et à l'automatisation de vos classeurs Excel.
Partagez cette discussion sur d'autres réseaux sociaux : Viadeo Twitter Google Facebook Digg Delicious MySpace Yahoo
Réponse Proposer ce sujet en actualité
 
Outils de la discussion
Publicité
'
Vieux 18/10/2011, 16h54   #1
Futur Membre du Club
 
Inscription : février 2006
Messages : 85
Détails du profil
Informations forums :
Inscription : février 2006
Messages : 85
Points : 18
Points : 18
Par défaut Pb Série. Xvalues

Bonjour,


J'ai une application qui fonctionne parfaitement sous 2003 et je dois la migrer sous 2010.
Le problème que j’ai une application pour créer un graphique qui fonctionne plus.

Apres l’analyse du code et l’exécution étape par étape j’ai constaté que .Xvalues et Values de la série ne prennent pas les données.

Ci-dessous le code la fonction est le probleme:

.XValues = rgAbsc
.Values = rgOrd


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
 
Public Sub addCurve(ByVal nomSerie As String, _
                    ByRef rgAbsc As String, _
                    ByRef rgOrd As String)
 
 
    Stop
 
    Dim nouvSerie As Series
 
    On Error GoTo GestErr:
 
'   Ajout d'une nouvelle série de données (i.e. une courbe)
    Set nouvSerie = clsGP.GPChartSC.NewSeries
 
'   Affectation des 3 caractéristiques : Nom, Abscisse, Ordonnée
    With nouvSerie
    .Name = nomSerie
    .XValues = rgAbsc
    .Values = rgOrd
' début modif oler 256+
    .Border.LineStyle = xlContinuous
' fin   modif oler 256+
    End With
 
    With nouvSerie.Border
    .ColorIndex = 5           ' bleu
    .Weight = xlMedium
    .LineStyle = xlContinuous
    End With
 
    With nouvSerie
    .MarkerBackgroundColorIndex = xlNone
    .MarkerForegroundColorIndex = xlNone
    .MarkerStyle = xlNone
    .Smooth = True
    .MarkerSize = 3
    .Shadow = False
    End With
 
    Exit Sub
 
GestErr:
 
    MsgBox "addCurve: Erreur N°" & Err.Number & vbCrLf & Err.Description, vbCritical, "Erreur"
 
End Sub

Or clsGP.GPChartSC.NewSeries :

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
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
 
Option Explicit
 
Public WithEvents GPChart As Chart
Public GPChartSC As SeriesCollection
Public WithEvents GPWorkSheet As Worksheet
 
Private x As Long
Private y As Long
Private Sub GPChart_BeforeDoubleClick(ByVal ElementID As Long, ByVal Arg1 As Long, ByVal Arg2 As Long, Cancel As Boolean)
    Cancel = True
End Sub
Private Sub GPChart_BeforeRightClick(Cancel As Boolean)
    Cancel = True
End Sub
Private Sub GPChart_DragPlot()
'
End Sub
Private Sub GPChart_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
'
End Sub
Private Sub GPChart_Resize()
'
End Sub
 
Public Sub GPWorkSheet_Calculate()
 
    Dim iNbPoints As Integer
    'Dim filiere As Integer
 
    Dim Ls_Age_Simu As Variant
    Dim Ls_Remun_Simu As Variant
 
    On Error GoTo GestErr:
 
    If Sh_Graphe.Columns(14).ColumnWidth <> 0 Then
 
        If iGP_SIMU_INDEX > -1 And Sh_Graphe.Range("Q30").Text <> "#VALEUR!" And Sh_Graphe.Range("Q30").Text <> "#VALUE!" Then
            Ls_Age_Simu = Sh_Graphe.Range("Q30").Text
            Ls_Remun_Simu = Sh_Graphe.Range("Q31").Text
 
            'Ls_Age_Simu = aGP_MATRICULES(iGP_SIMU_INDEX).Age
            'Ls_Remun_Simu = aGP_MATRICULES(iGP_SIMU_INDEX).Rattpr
 
 
            'on compte le nombre de points et on crée le point cible
            iNbPoints = GPChartSC.Count
            With aGP_MATRICULES(iGP_SIMU_INDEX)
                Call moveCiblePoint(GPChartSC.Item(iNbPoints), .ID, CSng(Ls_Age_Simu), CDbl(Ls_Remun_Simu))
            End With
        End If
 
    End If
 
    Exit Sub
 
GestErr:
 
    MsgBox "GPWorkSheet_Calculate: Erreur N°" & Err.Number & vbCrLf & Err.Description, vbCritical, "Erreur"
 
End Sub
 
Private Sub GPWorkSheet_Change(ByVal Target As Range)
    Dim iNbPoints As Integer
    Dim StrCourbeEtam As String
 
    Dim Ls_Age_Simu As Variant
    Dim Ls_Remun_Simu As Variant
 
    On Error GoTo GestErr:
 
    'filiere = 0
 
    If iMODE_AFFICHAGE = MODE_SIMU And bSIMU_EN_COURS Then
    'If iMODE_AFFICHAGE = MODE_SIMU Then
        Select Case Target.Row
        Case 30  'Age
            If Not IsNumeric(Target.Value) Then
                MsgBox "Veuillez entrer un nombre entre " & AGE_MINI & " et " & AGE_MAXI & " !", vbExclamation, "Attention"
                Range("X30").Select
                Exit Sub
            Else
                If CSng(Target.Value) < AGE_MINI Or CSng(Target.Value) > AGE_MAXI Then
                    MsgBox "Veuillez entrer un nombre entre " & AGE_MINI & " et " & AGE_MAXI & " !", vbExclamation, "Attention"
                    Range("Q8").Select
                    Exit Sub
                Else
                    With aGP_MATRICULES(iGP_SIMU_INDEX)
                    .Age_Simu = Target.Value
                    End With
                    Range("Q9").Select
                End If
            End If
        Case 31    ' Rémunération
            If Not IsNumeric(Target.Value) Then
                MsgBox "Veuillez entrer un nombre positif !", vbExclamation, "Attention"
                Range("X31").Select
                Exit Sub
            Else
                If CSng(Target.Value) <= 0 Then
                    MsgBox "Veuillez entrer un nombre positif !", vbExclamation, "Attention"
                    Range("Q9").Select
                    Exit Sub
                Else
                    With aGP_MATRICULES(iGP_SIMU_INDEX)
                        If Asc(.Statut_groupe) > 64 And Asc(.Statut_groupe) < 69 Then
                            .Remun_Simu = Target.Value
                        Else
                            .Rattpr = Target.Value
                        End If
                    End With
                    Range("Q8").Select
                End If
            End If
 
         Case 8 ' filiere (promotion cadre)
 
         End Select
 
        ' simulation cadre
        If Sh_Graphe.Columns(14).ColumnWidth <> 0 Then
            'With aGP_MATRICULES(iGP_SIMU_INDEX)
            '    .Age_Simu = Range("Q30").Value
            '    .Remun_Simu = Range("Q31").Value
            'End With
 
            Ls_Age_Simu = Sh_Graphe.Range("Q30").Text
            Ls_Remun_Simu = Sh_Graphe.Range("Q31").Text
 
        Else
            With aGP_MATRICULES(iGP_SIMU_INDEX)
 
                Ls_Age_Simu = .Age_Simu
 
                If Asc(.Statut_groupe) > 64 And Asc(.Statut_groupe) < 69 Then
                    Ls_Remun_Simu = .Remun_Simu
                Else
                    Ls_Remun_Simu = .Rattpr
                End If
            End With
        End If
 
        'on compte le nombre de points et on crée le point cible
        iNbPoints = GPChartSC.Count
        With aGP_MATRICULES(iGP_SIMU_INDEX)
            Call moveCiblePoint(GPChartSC.Item(iNbPoints), .ID, CSng(Ls_Age_Simu), CDbl(Ls_Remun_Simu))
        End With
    End If
 
    Exit Sub
 
GestErr:
 
    MsgBox "GPWorkSheet_Change: Erreur N°" & Err.Number & vbCrLf & Err.Description, vbCritical, "Erreur"
 
End Sub
Private Sub GPChart_Select(ByVal ElementID As Long, ByVal Arg1 As Long, ByVal Arg2 As Long)
 
    On Error GoTo GestErr:
 
    Select Case GPChartSC.Item(Arg1).Points.Count
    Case 1
        'MsgBox "C'est un point"
        x = CLng(Join(GPChartSC.Item(Arg1).XValues, ";"))
        y = CLng(Join(GPChartSC.Item(Arg1).Values, ";"))
    Case Else
        'MsgBox "C'est une courbe"
        'x = CLng(Split(GPChartSC.Item(Arg1).XValues, ";"))
        'y = CLng(Split(GPChartSC.Item(Arg1).Values, ";"))
    End Select
 
    Exit Function
 
GestErr:
 
    MsgBox "GPChart_Select: Erreur N°" & Err.Number & vbCrLf & Err.Description, vbCritical, "Erreur"
 
End Sub
Private Sub GPChart_SeriesChange(ByVal SeriesIndex As Long, ByVal PointIndex As Long)
 
    On Error GoTo GestErr:
 
    Select Case GPChartSC.Item(SeriesIndex).Points.Count
    Case 1
        'Dim p As Point
        'Set p = GPChartSC.Item(SeriesIndex).Points(PointIndex)
        'MsgBox "SeriesIndex: " & GPChartSC.Item(SeriesIndex).Name & vbCrLf & "point: " & p.Shadow
        GPChartSC.Item(SeriesIndex).XValues = x
        GPChartSC.Item(SeriesIndex).Values = y
    Case Else
        'GPChartSC.Item(SeriesIndex).XValues = x
        'GPChartSC.Item(SeriesIndex).Values = y
    End Select
 
    Exit Sub
 
GestErr:
 
    MsgBox "GPChart_SeriesChange: Erreur N°" & Err.Number & vbCrLf & Err.Description, vbCritical, "Erreur"
 
End Sub


Je ne comprends pas pourquoi ça ne veut pas fonctionner malgré que tout semble bien.

Merci de votre aide
hebh est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 20/10/2011, 17h01   #2
Membre Expert
 
Avatar de Jean-Pierre49
 
Homme J-Pierre Catherine
Conception Calcul
Inscription : juillet 2007
Messages : 659
Détails du profil
Informations personnelles :
Nom : Homme J-Pierre Catherine
Âge : 57
Localisation : France, Maine et Loire (Pays de la Loire)

Informations professionnelles :
Activité : Conception Calcul
Secteur : Industrie

Informations forums :
Inscription : juillet 2007
Messages : 659
Points : 1 856
Points : 1 856
à tout hasard

il y a peut être une évolution sur les graphiques avec 2010

as-tu tenté de refaire le bout de code avec l'enregistreur de macro

de toute façon il faut s'attendre à modifier des bouts de code en changeant de version

j'ai eu le cas avec 2007 et 2010

bon courage
__________________
Jean-Pierre Pensez à Voter pour les réponses qui vous ont aidés, d'avance merci
---------Et n'oubliez pas de mettre : ..quand c'est le cas !---------
Jean-Pierre49 est déconnecté   Envoyer un message privé Réponse avec citation 00
Réponse Proposer ce sujet en actualité
Outils de la discussion



Fuseau horaire GMT +2. Il est actuellement 15h49.


 
 
 
 
Partenaires

Hébergement Web