Discussion :

[VBA_girl]

Bonjour,

Je suis un peu novice en VBA et j’aurai besoin d’un peu d’aide dans mon programme.
J’ai beaucoup cherché dans les forums mais je n’ai pas trouvé la solution a mon problème donc je m’excuse d’avance si jamais je fais un doublon.
Voila j’ai plusieurs tableaux de 2 colonnes (une colonne de X et une colonne des Y) présents sur la feulle "data".
J’ai créé un bouton (présent aussi sur la feuille "Data") qui permet à l’aide d’une boucle de tracer la colonne des Y en fonction de la colonne des X dans un graphe et ce pour les différents tableaux présents dans ma feuille.
J’ai besoin aussi que la courbe de tendance et son équation apparaissent sur les différents graphiques (type: polynomiale d’ordre 3)
Les graphes sont présents dans une autre feuille nommée « Curves »
Mon problème est que mes graphiques se superposent sur la nouvelle feuille et comme ils ne sont pas nommés je ne sais pas comment les déplacer.

Pourriez-vous s’il vous plait m’indiquer comment les aligner sur ma nouvelle feuille ?

Voici mon code
Merci d’avance.

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
 
Private Sub CommandButton2_Click()
Dim i As Integer
Dim MonTitre As String
Dim nb_tableaux As Integer
 
ActiveSheet.CommandButton2.Caption = "Plot curves"
 
 
 nb_ tableaux = (Range(Cells(54, 2), Cells(54, 2).End(xlToRight)).Count) / 2
 
 
' Sheets("curves").ChartObjects.Delete Shift:=xlUp
 
Sheets("curves").Cells.Delete Shift:=xlUp
 
 For i = 2 To nb_tableaux * 2 Step 2
Application.ScreenUpdating = False
 
 Charts.Add
 
ActiveChart.Location Where:=xlLocationAsObject, Name:="curves"
 
    ActiveChart.ChartType = xlXYScatterSmooth ' Type nuage de points
 
    ActiveChart.SetSourceData Source:=Sheets("curves").Range("E42")
    ActiveChart.SeriesCollection.NewSeries
 
    ActiveChart.SeriesCollection(1).XValues = Range(Sheets("Data").Cells(54, i + 1), Sheets("Data").Cells(54, i + 1).End(xlDown))
 
    ActiveChart.SeriesCollection(1).Values = Range(Sheets("Data").Cells(54, i), Sheets("Data").Cells(54, i).End(xlDown))
 
 
    ActiveChart.Legend.Select
    Selection.Delete
 
 ActiveChart.SeriesCollection(1).Trendlines.Add(Type:=xlPolynomial, Order:=3, Forward:=0, Backward:=0, DisplayEquation:=True, DisplayRSquared:=False).Select
 
 
 
      With ActiveChart
MonTitre = Sheets("Data").Cells(51, i).Value
 
        .HasTitle = True
        .ChartTitle.Characters.Text = MonTitre
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "X"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Y "
   End With
 
    Next i
 
Application.ScreenUpdating = True
End Sub

[mercatog]

Bonjour

Essaies quelque chose dans ce genre

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
Private Sub CommandButton2_Click()
Dim i As Integer, Nb As Integer
Dim LastLig As Long, j As Long
Dim Plage As Range
Dim MonTitre As String
Dim Ch As ChartObject
 
Application.ScreenUpdating = False
With Sheets("curves")
    For Each Ch In .ChartObjects
        Ch.Delete
    Next Ch
End With
 
With Worksheets("Data")
    .CommandButton2.Caption = "Plot curves"
    Nb = Int((.Cells(54, .Columns.Count).End(xlToLeft).Column - 1) / 2)
    For i = 2 To Nb * 2 Step 2
        MonTitre = .Cells(51, i).Value
        LastLig = .Cells(.Rows.Count, i).End(xlUp).Row
        Set Plage = .Range(.Cells(54, i), .Cells(LastLig, i))
        TraceGraph Plage, MonTitre, j
        Set Plage = Nothing
        j = j + 200                              '200 la hauteur des graphiques
    Next i
End With
Application.ScreenUpdating = True
End Sub
 
 
Private Sub TraceGraph(PlageX As Range, ByVal MonTitre As String, ByVal t As Long)
Dim Grf As ChartObject
 
Set Grf = Worksheets("curves").ChartObjects.Add(0, t, 500, 200)    '0: gauche, t: haut, 500: largeur, 200 hauteur
With Grf.Chart
    .ChartType = xlXYScatterSmooth               ' Type nuage de points
    .SeriesCollection.NewSeries
    With .SeriesCollection(1)
        .XValues = PlageX
        .Values = PlageX.Offset(0, 1)
        .Trendlines.Add Type:=xlPolynomial, Order:=3, DisplayEquation:=True
    End With
    .HasLegend = False
    .HasTitle = True
    .ChartTitle.Characters.Text = MonTitre
    With .Axes(xlCategory)
        .HasTitle = True
        .AxisTitle.Characters.Text = "X"
    End With
    With .Axes(xlValue)
        .HasTitle = True
        .AxisTitle.Characters.Text = "Y"
    End With
End With
Set Grf = Nothing
End Sub

[VBA_girl]

C'est parfait ca marche comme sur des roulettes!

Merci beaucoup, ca faisait un petit moment que je bloquais la dessus...

Encore Merci mercatog