Problème dans la construction d'un graphique VBA

Version imprimable

Bonjour à tous,

Je débute en VBA et j'ai actuellement un problème pour la conception d'une macro qui doit me permettre de tracer des courbes.

Je dispose d'un tableau d'enregistrement dont la taille varie suivant les cas. Je compte donc les lignes de ce tableau, récupère les valeurs...et souhaite les tracer. Si le nombre de point est faible (inférieur à 30), aucun problème tout se trace correctement. Par contre, si mon nombre de données est important, j'ai un message d'erreur qui est le suivant:
"Impossible de définir la propriété XValues de la classe Series"

Je vous colle ci-dessous mon code en espérant que quelqu'un y voit la boulette qui me bloque.

Merci d'avance

Config:
Excel 2003
Windows XP

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
 
Dim time_Range As Range
Dim pression_Range As Range
Dim temperature_Range As Range
 
Dim time As Variant
Dim temperature As Variant
Dim pression As Variant
 
Sub utilisegraphique()
 
'Je déclare des plages qui sont trop grandes car je ne sais pas combien de lignes j'ai dans mon fichier
Set time_Range = Worksheets("Feuil").Range("a2:a1000")
Set pression_Range = Worksheets("Feuil").Range("c2:c1000")
Set temperature_Range = Worksheets("Feuil").Range("b2:c1000")
 
'Je compte le nombre de ligne que j'ai dans mes tableaux (le comptage est 'basique mais étant donné que je débute, je ne connais pas encore la 'fonction qui pourrait être plus raffinée)
 
For i = 1 To 1000
    If IsEmpty(time_Range.Cells(i)) Then
        i = 1000
    Else
        j = j + 1
    End If
Next i
 
'Je dimensionne mes vecteurs à la bonne dimension
ReDim time(1 To j) As Double
ReDim pression(1 To j) As Double
ReDim temperature(1 To j) As Double
 
'J'affecte les valeurs à mes vecteurs
 
For i = 1 To j
    time(i) = time_Range.Cells(i)
    pression(i) = pression_Range.Cells(i)
    temperature(i) = temperature_Range.Cells(i)
Next i
 
'Je réalise mes graphes
 
Call Graphique(time, pression, "Pression en fonction du temps", "Temps [s]", "Pression [bar]", "Pression")
Call Graphique(time, temperature, "Temperature en fonction du temps", "Temps [s]", "Temperature [°C]", "Temperature")
 
End Sub
 
Sub Graphique(a As Variant, b As Variant, Titre As String, LegendeX As String, LegendeY As String, Nom As String)
 
    Charts.Add
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).XValues = a
    ActiveChart.SeriesCollection(1).Values = b
    ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=Nom
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = Titre
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = LegendeX
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = LegendeY
    End With
 
End Sub

06/11/2009, 11h36
Fvandermeulen
Salut,
J'avoue que c'est pas évident sans le fichier de 'voir' où ça bloque...Si tu peux mettre le fichier (donc si rien de confidentiel) ça aidera.

Par contre tu indique ne pas savoir comment connaitre le nombre de ligne, voici une méthode, sur base de la colonne 1 (col A); DerLig renvoi le numéro de la dernière ligne remplie:
Code:

1 2 Dim DerLig as long DerLig = sheets("TaFeuille").cells(columns(1).cells.count,1).end(xlup).row
A+
06/11/2009, 14h04
Piernod

1 pièce(s) jointe(s)

Pas de problème, le fichier n'est pas confidentiel. J'ai mis des valeurs bidons dans les cellules. Voilà en tout cas à quoi cela ressemble. Merci d'avance

Merci en tout cas pour la commande pour obtenir la dernière ligne du tableau :ccool:
06/11/2009, 14h28
Fvandermeulen
Re,
J'ai une erreur sur les lignes ci-dessous, que doit retourner a et b ?
Code:

1 2 ActiveChart.SeriesCollection(1).XValues = a ActiveChart.SeriesCollection(1).Values = b
A+
06/11/2009, 14h32
Piernod

1 pièce(s) jointe(s)

Je viens de faire une modif sur mon code. ça me permet de tracer mon premier graphique correctement mais le deuxième bloque ensuite. Je mets le nouveau fichier en pièce jointe.

La modif que j'ai apporté c'est que avant, les attributs de ma sub Graphique qui étaient appelés a et b étaient des variant. Je les déclare désormais comme des Range et les affecte ensuite à XAdr et YAdr qui sont eux aussi des Range.

Le premier graphique se trace nickel. Par contre lorsque le deuxième se fait, je me retrouve avec des Series en plus et le même bug qu'avant.

Re,
J'avoue ne pas bien avoir saisi toutes les actions de ton code, sauf erreur j'arrive au résultat souhaité avec 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
Sub utilisegraphique()
 
'Je réalise mes graphes
Call Graphique(time_Range, pression_Range, "Pression en fonction du temps", "Temps [s]", "Pression [bar]", "Pression")
Call Graphique(time_Range, temperature_Range, "Temperature en fonction du temps", "Temps [s]", "Temperature [°C]", "Temperature")
 
End Sub
 
Sub Graphique(a As Range, b As Range, Titre As String, LegendeX As String, LegendeY As String, Nom As String)
Dim DerLig As Long
Dim LaCol As Byte
DerLig = Sheets("Feuil").Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
If Nom = "Pression" Then 'Choisi la colonne pour la source de données en fonction du nom du graphique
    LaCol = 3
Else
    LaCol = 2
End If
    Set XAdr = Sheets("Feuil").Range(Cells(2, 1), Cells(DerLig, 1))
    Set YAdr = Sheets("feuil").Range(Cells(2, LaCol), Cells(DerLig, LaCol))
 
    Charts.Add
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).XValues = XAdr
    ActiveChart.SeriesCollection(1).Values = YAdr
    ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=Nom
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = Titre
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = LegendeX
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = LegendeY
    End With
 
Sheets("Feuil").Select
 
End Sub

Dis moi...

A+

06/11/2009, 15h01
Piernod

Merci beaucoup !!

ça marche très bien. C'est pour pouvoir appliquer sur une macro un peu plus conséquente. Donc maintenant, je vais pouvoir adapter ça à mon application. Merci encore.