Tableau et graphique

Version imprimable

Bonjour à tous,

voici mon 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
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

06/03/2012, 10h55
Daniel.C

Bonjour,

Je n'ai pas de problème avec XL2010. Quelle est ta version d'Excel ?
06/03/2012, 14h40
Vincent32

1 pièce(s) jointe(s)

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

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

Déplace la ligne :

Code:

.HasTitle = False

ici

Code:

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

06/03/2012, 20h54
Vincent32

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
06/03/2012, 21h07
Daniel.C

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é.

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:

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

Bon j'ai modifié mon code :
je prends plus de valeurs pour tracer mes courbes (jusqu'à 20 000 001 de points max) et je redimensionne mes tableaux séparément ça donne ceci :

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
'Définition du tableau XA
w = 0
For i = -10000 To 10000 Step 0.001
    w = w + 1
Next i
ReDim XA(w)
i = -10000
For y = 0 To w
    XA(y) = i
    i = i + 0.001
Next y
 
'Pic n°1
If H1 <> 0 Then
    z = 0
    For i = 0 To w
        If P1 + XA(i) > 0 Then
           z = z + 1
        End If
    Next i
    ReDim X1A(z)
    ReDim X1O(z)
    y = 0
    For i = 0 To w
        If P1 + XA(i) > 0 Then
            X1A(y) = XA(i) + P1 'P1=position du pic renseignée dans l'userform
            X1O(y) = 2.718281828 ^ (-2.772588722 * XA(i) ^ 2 / (H1 ^ 2))
            y = y + 1
        End If
    Next i
End If

Le programme tourne correctement jusqu'au 20ième pic. Cependant au moment de tracer le spectre (graphique) du premier pic (c'est la première courbe). J'ai un msg d'erreur : "Incompatibilité de type" avec la ligne suivante surligné en jaune

Code:

.SeriesCollection(1).XValues = X1A()

elle fait partie de :

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
With Sheets("Spectre")
    .ChartArea.Clear
    .ChartType = xlXYScatter
    .HasLegend = 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
     .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

07/03/2012, 10h21
Daniel.C

Bonjour,

Poste les macros modifiées dans leur intégralité. La syntaxe pour redimensionner un tableau sans perdre les données est :

Code:

ReDim Preserve Tableau(x)
07/03/2012, 10h51
Vincent32

1 pièce(s) jointe(s)

Merci pour ton aide Daniel voici mon code modifié (voir PJ) entre-temps je teste avec ta fonction:

Redim Preserve

Encore merci
07/03/2012, 11h11
Vincent32

J'ai toujours ce problème "incompatibilité de type" je n'arrive pas à comprendre
07/03/2012, 12h43
Daniel.C

C'est sans doute parce que je fais de mauvaises manips. Je valide l'userform avec les valeurs présentes sans en ajouter.
J'ai les erreurs successives
dans "Pic 1" :Y10 : sub ou fonction non définie. J'ai remplacé :

Code:

Y10(y) = 2.718281828 ^ (-2.772588722 * XA(i) ^ 2 / (H1 ^ 2))

par :

Code:

Y1(y) = 2.718281828 ^ (-2.772588722 * XA(i) ^ 2 / (H1 ^ 2))

Même chose pour Pic 2.
Pour ton message d'erreur, le nombre de valeurs de X1 est de 100 001 501 valeurs. Je pense que le nombre de valeurs est au maximum de quelques milliers.

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:

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:

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:

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

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

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
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:

.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

J'allais te dire que cela fonctionnait si on copiait les tableaux sur une feuille :

Code:

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:

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

08/03/2012, 10h25
Vincent32

1 pièce(s) jointe(s)

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:ave:

Bonne journée à tous