Tableau et graphique

**Vincent32** · 06/03/2012, 10h30

Bonjour à tous,

voici mon code

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
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
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
'déclaration de variable
Public XA(128) As Long
 
Public P1 As Long
Public H1 As Long
Public X1A() As Long
Public X1O() As Long
 
Public z As Integer
 
 
Sub Macro()
    UserForm1.Show
End Sub
 
Sub Simulation_solide()
 
'Définition du tableau XA
XA(0) = "-10000"
XA(1) = "-9000"
XA(2) = "-8000"
XA(3) = "-7000"
XA(4) = "-6000"
XA(5) = "-5000"
XA(6) = "-4000"
XA(7) = "-3000"
XA(8) = "-2000"
XA(9) = "-1000"
XA(10) = "-900"
XA(11) = "-800"
XA(12) = "-700"
XA(13) = "-600"
XA(14) = "-500"
XA(15) = "-400"
XA(16) = "-300"
XA(17) = "-200"
XA(18) = "-100"
XA(19) = "-90"
XA(20) = "-80"
XA(21) = "-70"
XA(22) = "-60"
XA(23) = "-50"
XA(24) = "-40"
XA(25) = "-30"
XA(26) = "-20"
XA(27) = "-10"
XA(28) = "-9"
XA(29) = "-8"
XA(30) = "-7"
XA(31) = "-6"
XA(32) = "-5"
XA(33) = "-4"
XA(34) = "-3"
XA(35) = "-2"
XA(36) = "-1"
XA(37) = "-0,9"
XA(38) = "-0,8"
XA(39) = "-0,7"
XA(40) = "-0,6"
XA(41) = "-0,5"
XA(42) = "-0,4"
XA(43) = "-0,3"
XA(44) = "-0,2"
XA(45) = "-0,1"
XA(46) = "-0,09"
XA(47) = "-0,08"
XA(48) = "-0,07"
XA(49) = "-0,06"
XA(50) = "-0,05"
XA(51) = "-0,04"
XA(52) = "-0,03"
XA(53) = "-0,02"
XA(54) = "-0,011"
XA(55) = "-0,009"
XA(56) = "-0,008"
XA(57) = "-0,007"
XA(58) = "-0,006"
XA(59) = "-0,005"
XA(60) = "-0,004"
XA(61) = "-0,003"
XA(62) = "-0,002"
XA(63) = "-0,001"
XA(64) = "0"
XA(65) = "0,001"
XA(66) = "0,002"
XA(67) = "0,003"
XA(68) = "0,004"
XA(69) = "0,005"
XA(70) = "0,006"
XA(71) = "0,007"
XA(72) = "0,008"
XA(73) = "0,009"
XA(74) = "0,01"
XA(75) = "0,02"
XA(76) = "0,03"
XA(77) = "0,04"
XA(78) = "0,05"
XA(79) = "0,06"
XA(80) = "0,07"
XA(81) = "0,08"
XA(82) = "0,09"
XA(83) = "0,1"
XA(84) = "0,2"
XA(85) = "0,3"
XA(86) = "0,4"
XA(87) = "0,5"
XA(88) = "0,6"
XA(89) = "0,7"
XA(90) = "0,8"
XA(91) = "0,9"
XA(92) = "1"
XA(93) = "2"
XA(94) = "3"
XA(95) = "4"
XA(96) = "5"
XA(97) = "6"
XA(98) = "7"
XA(99) = "8"
XA(100) = "9"
XA(101) = "10"
XA(102) = "20"
XA(103) = "30"
XA(104) = "40"
XA(105) = "50"
XA(106) = "60"
XA(107) = "70"
XA(108) = "80"
XA(109) = "90"
XA(110) = "100"
XA(111) = "200"
XA(112) = "300"
XA(113) = "400"
XA(114) = "500"
XA(115) = "600"
XA(116) = "700"
XA(117) = "800"
XA(118) = "900"
XA(119) = "1000"
XA(120) = "2000"
XA(121) = "3000"
XA(122) = "4000"
XA(123) = "5000"
XA(124) = "6000"
XA(125) = "7000"
XA(126) = "8000"
XA(127) = "9000"
XA(128) = "10000"
 
'Rafraichissement de l'écran
       Application.ScreenUpdating = False
 
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
 
'Pic n°1
If H1 <> 0 Then
    z = 0
    For i = 0 To 128
        If P1 + XA(i) > 0 Then
           X1A(z) = XA(i) + P1 'P1=position du pic renseignée dans l'userform
           X1O(z) = 2.718281828 ^ (-2.772588722 * XA(i) ^ 2 / (H1 ^ 2))
           z = z + 1
        End If
    Next i
End If
 
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
 
'Tracé du spectre (graphique)
 
With Sheets("Spectre")
    .ChartArea.Clear
    .ChartType = xlXYScatter
    .HasLegend = False
    .HasTitle = False
    If H1 <> 0 Then
        .SeriesCollection.NewSeries
        .SeriesCollection(1).XValues = X1A()
        .SeriesCollection(1).Values = X1O()
        .SeriesCollection(1).Border.Weight = xlHairline
        .SeriesCollection(1).Border.LineStyle = xlContinuous
        .SeriesCollection(1).MarkerBackgroundColorIndex = xlNone
        .SeriesCollection(1).MarkerForegroundColorIndex = xlNone
        .SeriesCollection(1).MarkerStyle = xlNone
        .SeriesCollection(1).Smooth = True
        .SeriesCollection(1).Shadow = True
    End If
End With
 
With Sheets("Spectre").Axes(xlCategory) 'axe des abscisses
    .HasTitle = True 'définition du titre des abscisses
    .AxisTitle.Characters.Text = "T2 (ms)"
    .AxisTitle.Characters(Start:=2, Length:=1).Font.Subscript = True
    .AxisTitle.Font.ColorIndex = 1
    .AxisTitle.Font.Name = "Arial"
    .AxisTitle.Font.FontStyle = "Gras"
    .AxisTitle.Font.Size = 12
    .MinimumScale = 0.001 'valeur minimale
    .MaximumScale = 100 'valeur maximale
    .Crosses = xlMinimum 'ordonnée à gauche
    .ScaleType = xlLogarithmic
    .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 = 1 'couleur noir
        .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 = 1 'couleur (1=noir)
        .Background = xlAutomatic 'couleur du fond
    End With
End With
 
With Sheets("Spectre").Axes(xlValue) 'axe des  ordonnées
    .HasTitle = True 'définition du titre des ordonnées
    .AxisTitle.Characters.Text = "Intensité (U.A.)"
    .AxisTitle.Font.ColorIndex = 1
    .AxisTitle.Font.Name = "Arial"
    .AxisTitle.Font.FontStyle = "Gras"
    .AxisTitle.Font.Size = 12
    .HasMajorGridlines = True
    .HasMinorGridlines = False
    .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
    .MinimumScale = 0 'valeur minimale
    .MaximumScale = 1 'valeur maximale
    .MajorUnit = 0.5 'unité principale
    .Crosses = xlMinimum '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 = 1 'couleur noir
        .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 = 1 'couleur (1=Noir)
        .Background = xlAutomatic 'couleur du fond
    End With
End With
 
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
 
'La simulation est terminée.
 
Select Case MsgBox("La simulation du spectre RMN est terminé." & Chr(10) & "Souhaitez vous sauvegarder ce classeur ?", vbYesNo + vbInformation, "Fin de la simulation")
    Case vbYes
        Application.Dialogs(xlDialogSaveAs).Show
        Sheets("Spectre").Select
    Case vbNo
        Sheets("Spectre").Select
        Exit Sub
End Select
 
End Sub

La partie tracé du spectre ne fonctionne pas voici l'erreur que j'obtiens :
Erreur : Impossible de définir la propriété HasTitle de la classe Chart.

Une (des) idée(s) ?

Merci pour votre aide

J'ai remplacé les Long par des variables de type Double

**Daniel.C** · 06/03/2012, 10h55

Bonjour,

Je n'ai pas de problème avec XL2010. Quelle est ta version d'Excel ?

**Vincent32** · 06/03/2012, 14h40

Je dispose d'excel 2003.

Je suis en train de modifier un peu mon code dès que j'ai terminé je le mets en ligne s'il ne fonctionne tjs pas

Pour info tu obtiens une gaussienne ?

Voilà je joins mon fichier.

Je n'arrive pas à comprendre ce qui cloche.

En même temps c'est la première fois que j'utilise des tableaux.

Le but de ce programme est de simuler des spectres RMN

1 pic =1 courbe
tous les pics ont une même intensité (=1)
tous les pics ont une forme gaussienne
chaque pic à sa propre largeur à mi hauteur
chaque pic à sa propre position
solide ou liquide modifie juste les échelles
les nombres à virgule sont pris en compte

Si quelqu'un peut me dire ce qui cloche

**Daniel.C** · 06/03/2012, 18h50

Effectivement, ça coince avec XL2003. IL faut mettre la ligne après la création des séries :

Déplace la ligne :

Code :

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

    .HasTitle = False

ici

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
    If H20 <> 0 Then
        .SeriesCollection.NewSeries
        .SeriesCollection(20).XValues = X20A()
        .SeriesCollection(20).Values = X20O()
        .SeriesCollection(20).Border.Weight = xlHairline
        .SeriesCollection(20).Border.LineStyle = xlContinuous
        .SeriesCollection(20).MarkerBackgroundColorIndex = xlNone
        .SeriesCollection(20).MarkerForegroundColorIndex = xlNone
        .SeriesCollection(20).MarkerStyle = xlNone
        .SeriesCollection(20).Smooth = True
        .SeriesCollection(20).Shadow = True
    End If
    .HasTitle = False

**Vincent32** · 06/03/2012, 20h54

Merci beaucoup pour ta réponse Daniel,

Je regarde ça demain matin et je te tiens au courant.

Par contre j'ai essayé la macro sur XL2007 et 2010 (PC ne m’appartenant pas) et la macro semble tourner correctement au détail près qu'aucun spectre ne s'affiche était-ce le cas pour toi ?

Il faudrait que j'ai accès aux data de mon tableau pour vérifier par contre je n'arrive pas à comprendre comment faire pour récupérer les data du tableau 1 et les insérer dans la feuille 1

Encore merci pour ton aide

**Daniel.C** · 06/03/2012, 21h07

Je n'obtiens rien de visible. Comme je ne sais pas ce que fais ta macro, je ne me suis soucié que du problème évoqué.

**Vincent32** · 07/03/2012, 07h59

Bon effectivement je n'ai plus de msg d'erreur cependant rien ne s'affiche.

Je pense avoir une idée de l'origine du problème mais je n'en suis pas sûr :

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
Public P20 As Double
Public H20 As Double
Public X20A() As Double
Public X20O() As Double
 
Public i As Integer
Public z As Integer
 
 
If H20 <> 0 Then
    z = 0
    For i = 0 To 128
        If P20 + XA(i) > 0 Then
           ReDim X20A(z)
           ReDim X20O(z)
           X20A(z) = XA(i) + P1 'P1=position du pic renseignée dans l'userform; sert d'axe des abscisses pour tracer la courbe 20 avec XA(i) des valeurs fixes stockées dans un tableau
           X20O(z) = 2.718281828 ^ (-2.772588722 * XA(i) ^ 2 / (H20 ^ 2))'calcul les ordonnées de la courbe 20
           z = z + 1'incrément pour ajouter une ligne au tableau si nécessaire
        End If
    Next i
End If

Est ce que à chaque fois que je redimensionne mon tableau j'efface les données qu'il contenait auparavant. Car le but de ma boucle est d'ajouter une ligne à chaque fois sans effacer les données précédentes.

Mais ça peut être autre chose. C'est la première fois que j'utilise des variables tableau.

Merci pour ton aide Daniel

**Vincent32** · 07/03/2012, 16h46

Effectivement j'avais les erreurs que tu m'as annoncées.

J'ai effectué les modifications et ça fonctionne j'ai un premier pic.

Maintenant j'ai un autre problème sur cette partie :

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
If H1 <> 0 Then
        .SeriesCollection.NewSeries
        .SeriesCollection(1).XValues = X1()
        .SeriesCollection(1).Values = Y1()
        .SeriesCollection(1).Border.Weight = xlHairline
        .SeriesCollection(1).Border.LineStyle = xlContinuous
        .SeriesCollection(1).MarkerBackgroundColorIndex = xlNone
        .SeriesCollection(1).MarkerForegroundColorIndex = xlNone
        .SeriesCollection(1).MarkerStyle = xlNone
        .SeriesCollection(1).Smooth = True
        .SeriesCollection(1).Shadow = True
    End If
    If H2 <> 0 Then
        .SeriesCollection.NewSeries
        .SeriesCollection(2).XValues = X2()
        .SeriesCollection(2).Values = Y2()
        .SeriesCollection(2).Border.Weight = xlHairline
        .SeriesCollection(2).Border.LineStyle = xlContinuous
        .SeriesCollection(2).MarkerBackgroundColorIndex = xlNone
        .SeriesCollection(2).MarkerForegroundColorIndex = xlNone
        .SeriesCollection(2).MarkerStyle = xlNone
        .SeriesCollection(2).Smooth = True
        .SeriesCollection(2).Shadow = True
    End If

Il ne veut pas me tracer une deuxième série car j'ai déjà des XValues (celles de ma première série).

J'imagine à peu près ce qu'il faut faire il faut que je crée un nouveau tableau avec toutes les valeurs de x possible et que je boucle dessus je vais voir ce que j'arrive à faire et je vous tiens au courant

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
137
138
'déclaration de variable
 
Public P1 As Double
Public H1 As Double
Public Y1() As Double
 
Public XS() As Double
 
Public a As Double
Public b As Double
 
Sub Macro()
 
Erase XS, Y1
UserForm1.Show
 
End Sub
 
Sub Simulation_solide()
 
'Définition des abscisses
a = -1
For b = 0.001 To 100 Step 0.001
    a = a + 1
    ReDim Preserve XS(a)
    XS(a) = b
Next b
'Rafraichissement de l'écran
       Application.ScreenUpdating = False
 
 
'Pic n°1
If H1 <> 0 Then
    a = -1
    For b = 0 To 100 Step 0.001
        a = a + 1
        ReDim Preserve Y1(a)
        Y1(a) = 2.718281828 ^ (-2.772588722 * (XS(a) - P1) ^ 2 / (H1 ^ 2))
    Next b
End If
 
'Tracé du spectre (graphique)
 
With Sheets("Spectre")
    .ChartArea.Clear
    .ChartType = xlXYScatter
    .HasLegend = False
    If H1 <> 0 Then
        .SeriesCollection.NewSeries
        .SeriesCollection(1).XValues = XS()
        .SeriesCollection(1).Values = Y1()
        .SeriesCollection(1).Border.Weight = xlHairline
        .SeriesCollection(1).Border.LineStyle = xlContinuous
        .SeriesCollection(1).MarkerBackgroundColorIndex = xlNone
        .SeriesCollection(1).MarkerForegroundColorIndex = xlNone
        .SeriesCollection(1).MarkerStyle = xlNone
        .SeriesCollection(1).Smooth = True
        .SeriesCollection(1).Shadow = True
    End If
     .HasTitle = False
End With
 
With Sheets("Spectre").Axes(xlCategory) 'axe des abscisses
    .HasTitle = True 'définition du titre des abscisses
    .AxisTitle.Characters.Text = "T2 (ms)"
    .AxisTitle.Characters(Start:=2, Length:=1).Font.Subscript = True
    .AxisTitle.Font.ColorIndex = 1
    .AxisTitle.Font.Name = "Arial"
    .AxisTitle.Font.FontStyle = "Gras"
    .AxisTitle.Font.Size = 12
    .MinimumScale = 0.001 'valeur minimale
    .MaximumScale = 100 'valeur maximale
    .Crosses = xlMaximum 'ordonnée à gauche
    .ScaleType = xlLogarithmic
    .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 = 1 'couleur noir
        .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
        .ColorIndex = 1 'couleur (1=noir)
    End With
End With
 
With Sheets("Spectre").Axes(xlValue) 'axe des  ordonnées
    .HasTitle = True 'définition du titre des ordonnées
    .AxisTitle.Characters.Text = "Intensité (U.A.)"
    .AxisTitle.Font.ColorIndex = 1
    .AxisTitle.Font.Name = "Arial"
    .AxisTitle.Font.FontStyle = "Gras"
    .AxisTitle.Font.Size = 12
    .HasMajorGridlines = 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
    .MinimumScale = 0 'valeur minimale
    .MaximumScale = 1 'valeur maximale
    .MajorUnit = 0.5 'unité principale
    .Crosses = xlMaximum 'Défini à quelle valeur l'axe X coupe l'axe Y
    .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 = 1 'couleur noir
        .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
        .ColorIndex = 1 'couleur (1=Noir)
    End With
End With
 
'Rafraichissement de l'écran
Application.ScreenUpdating = True
 
'La simulation est terminée.
 
Select Case MsgBox("La simulation du spectre RMN est terminé." & Chr(10) & "Souhaitez vous sauvegarder ce classeur ?", vbYesNo + vbInformation, "Fin de la simulation")
    Case vbYes
        Application.Dialogs(xlDialogSaveAs).Show
        Sheets("Spectre").Select
    Case vbNo
        Sheets("Spectre").Select
        Exit Sub
End Select
 
End Sub

Ce code me pose encore des problèmes la ligne suivante : l'indice n'appartient pas à la sélection !

Code :

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

Y1(a) = 2.718281828 ^ (-2.772588722 * (XS(a) - P1) ^ 2 / (H1 ^ 2))

**Vincent32** · 07/03/2012, 18h11

Bon j'ai résolu le problème précédent

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
Option Base 1
 
Public P1 As Double
Public H1 As Double
Public Y1() As Double
 
Public XS() As Double
 
Public a As Double
Public b As Double
 
 
 
Sub Macro()
 
Erase XS, Y1
UserForm1.Show
 
End Sub
 
Sub Simulation_solide()
 
'Définition des abscisses
a = 0
For b = 0.1 To 10 Step 0.1
    a = a + 1
    ReDim Preserve XS(a)
    XS(a) = b
Next b
'Rafraichissement de l'écran
       Application.ScreenUpdating = False
 
'Pic n°1
If H1 <> 0 Then
    a = 0
    For b = 0.1 To 10 Step 0.1
        a = a + 1
        ReDim Preserve Y1(a)
        Y1(a) = 2.718281828 ^ (-2.772588722 * (XS(a) - P1) ^ 2 / (H1 ^ 2))
    Next b
    MsgBox ("nb lignes XS : " & UBound(XS) & Chr(10) & "nb lignes Y1 : " & UBound(Y1))
End If
 
'Tracé du spectre (graphique)
 
With Sheets("Spectre")
    .ChartArea.Clear
    .ChartType = xlXYScatter
    .HasLegend = False
    If H1 <> 0 Then
        .SeriesCollection.NewSeries
        .SeriesCollection(1).XValues = XS()
        .SeriesCollection(1).Values = Y1()
        .SeriesCollection(1).Border.Weight = xlHairline
        .SeriesCollection(1).Border.LineStyle = xlContinuous
        .SeriesCollection(1).MarkerBackgroundColorIndex = xlNone
        .SeriesCollection(1).MarkerForegroundColorIndex = xlNone
        .SeriesCollection(1).MarkerStyle = xlNone
        .SeriesCollection(1).Smooth = True
        .SeriesCollection(1).Shadow = True
    End If
 
     .HasTitle = False
End With
 
With Sheets("Spectre").Axes(xlCategory) 'axe des abscisses
    .HasTitle = True 'définition du titre des abscisses
    .AxisTitle.Characters.Text = "T2 (ms)"
    .AxisTitle.Characters(Start:=2, Length:=1).Font.Subscript = True
    .AxisTitle.Font.ColorIndex = 1
    .AxisTitle.Font.Name = "Arial"
    .AxisTitle.Font.FontStyle = "Gras"
    .AxisTitle.Font.Size = 12
    .MinimumScale = 0.001 'valeur minimale
    .MaximumScale = 100 'valeur maximale
    .Crosses = xlMaximum 'ordonnée à gauche
    .ScaleType = xlLogarithmic
    .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 = 1 'couleur noir
        .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
        .ColorIndex = 1 'couleur (1=noir)
    End With
End With
 
With Sheets("Spectre").Axes(xlValue) 'axe des  ordonnées
    .HasTitle = True 'définition du titre des ordonnées
    .AxisTitle.Characters.Text = "Intensité (U.A.)"
    .AxisTitle.Font.ColorIndex = 1
    .AxisTitle.Font.Name = "Arial"
    .AxisTitle.Font.FontStyle = "Gras"
    .AxisTitle.Font.Size = 12
    .HasMajorGridlines = 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
    .MinimumScale = 0 'valeur minimale
    .MaximumScale = 1 'valeur maximale
    .MajorUnit = 0.5 'unité principale
    .Crosses = xlMaximum 'Défini à quelle valeur l'axe X coupe l'axe Y
    .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 = 1 'couleur noir
        .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
        .ColorIndex = 1 'couleur (1=Noir)
    End With
End With
 
End Sub

Mais un problème subsiste :

"Impossible de définir la propriété XValues de la classe Series" avec cette ligne surlignée en jaune :

Code :

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

.SeriesCollection(1).XValues = XS()

Merci pour votre aide

Bon à priori si le nb de data dans un tableau est trop important (100 valeurs c'est déjà trop), il ne peut pas tracer le graphique

Je vais donc copier mes datas sur une feuille et ensuite tracer le graphique.

Pouvez vous m'indiquer la procédure pour récupérer toutes les data d'un tableau à 1 dimension dans la colonne A de la feuille 1 (même avec le tuto je n'y arrive pas)

Merci pour votre aide

**Daniel.C** · 07/03/2012, 18h59

J'allais te dire que cela fonctionnait si on copiait les tableaux sur une 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
21
With Sheets("Spectre")
    .ChartArea.Clear
    .ChartType = xlXYScatter
    .HasLegend = False
    If H1 <> 0 Then
        .SeriesCollection.NewSeries
        [A1:A100] = Application.Transpose(XS)
        .SeriesCollection(1).XValues = [Feuil1!G1:G100]
        [B1:B100] = Application.Transpose(Y1)
        .SeriesCollection(1).Values = [Feuil1!H1:H100]
        .SeriesCollection(1).Border.LineStyle = xlContinuous
        .SeriesCollection(1).Border.Weight = xlHairline
        .SeriesCollection(1).MarkerBackgroundColorIndex = xlNone
        .SeriesCollection(1).MarkerForegroundColorIndex = xlNone
        .SeriesCollection(1).MarkerStyle = xlNone
        .SeriesCollection(1).Smooth = True
        .SeriesCollection(1).Shadow = True
    End If
 
     .HasTitle = False
End With

Quand tu utilises une variable array pour renseigner soit "Values" ou "XValues", elle ne peut pas dépasser 251 caractères environ. J'ai fait cet essai et ça plante à 256 caractères :

Code :

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

1
2
3
4
5
6
        For i = 1 To 1000
            ReDim Preserve tabl(i)
            tabl(i) = 1
            var = var + Len(i)
            .SeriesCollection(1).XValues = tabl
        Next i

**Vincent32** · 08/03/2012, 10h25

Bonjour à tous,

Cher Daniel,

Un énorme merci à Daniel pour son aide dans ce projet. Il ne me reste qu'une petite coquille : lorsque ma largeur à mi-hauteur est plus grande que ma position de pic alors ma Gaussienne fait pale figure. Cependant ça relève du détail et je vais résoudre ceci (si le problème venait à se poser (car pour l'instant je n'ai pas de largeur supérieur à la position)) moi même.

Donc encore merci Daniel.

Pour les curieux je joints mon fichier finalisé pour info, en ce qui concerne les solides les pics dont la position est inférieure à 0.01 ne sont pas affichés.

Merci merci et encore merci Daniel pour le temps que tu m'as accordés, les solutions que tu m'as apporté, ta patience et ton aide

Bonne journée à tous

Tableau et graphique [XL-2003]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager