Discussion :

[othmane_007_007]

Bonjour,

J'ai un soucis avec mon code, je n'arrive pas à supprimer l'ancien graphique quand je lance la création d'un nouveau graph
Ci-dessous vous trouverez mon code (j'ai utilisé enregistrement macro)

j'ai une deuxième question a vous poser : comment faire pour que le graph apparaît dans une nouvelle feuille

Bien à vous,

Othmane

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
Sub graphique()
    Dim Plage As Range
    Dim Lignes(), i As Long
    Dim texte As String
    Dim Flag As Boolean
 
    Set Plage = Sheets("Feuille de calculs").Columns(22) 'plage de recherche
    texte = "Ventilateur"   'expression cherchée
    Flag = Find_Next(Plage, texte, Lignes())  'appel de la fonction
    If Flag Then  'si fonction retourne Vrai = expression trouvée dans la plage
        For i = LBound(Lignes) To UBound(Lignes)   'restitution des lignes correspondantes
            Debug.Print Lignes(i)
            If i > 0 Then
                MsgBox "Erreur : Vous avez placé plus d'un repère." & vbCr & vbCr & "Veuillez introduire seulement un repère."
                GoTo hors
            End If
            If i = 0 Then
                Set b = Range("B13:B60")
                For c = 1 To b.Rows.Count
                    If Not IsEmpty(b.Cells(c, 1)) Then
                        Set r = Range("V13:V60")
                        For n = 1 To r.Rows.Count
                            If Not IsEmpty(r.Cells(n, 1)) Then
                                For j = 1 To n
                                    r.Cells(j, 1).Offset(0, 2).Value = 0 - r.Cells(j, 1).Offset(0, -1).Value 'pour les ordonnées
                                    r.Cells(j, 1).Offset(0, 3).Value = r.Cells(j, 1).Offset(0, 1).Value 'pour longueur donc les abscisses
                                Next j
                                r.Cells(n + 1, 1).Offset(0, 2).Value = r.Cells(j, 1).Offset(0, -1).End(xlDown).Value - r.Cells(n, 1).Offset(0, -1).Value 'pour les ordonnées
                                r.Cells(n + 1, 1).Offset(0, 3).Value = r.Cells(n, 1).Offset(0, 1).Value 'pour longueur donc les abscisses
                                For x = n + 2 To c + 1
                                    r.Cells(x, 1).Offset(0, 2).Value = r.Cells(x - 1, 1).Offset(0, 2).Value - r.Cells(x, 1).Offset(-1, -4).Value - r.Cells(x, 1).Offset(-1, -2).Value 'pour les ordonnées
                                    r.Cells(x, 1).Offset(0, 3).Value = r.Cells(x - 1, 1).Offset(0, 1).Value 'pour longueur donc les abscisses
                                Next x
                            End If
                        Next n
                    End If
                Next c
            End If
        Next i
    End If
    Macroenreg
hors:
End Sub
 
Private Sub Macroenreg()
 
    ActiveWindow.SmallScroll Down:=-12
    Range("X13:Y55").Select
    Range("Y13").Activate
    ActiveSheet.Shapes.AddChart2(240, xlXYScatterLines).Select
    ActiveChart.SetSourceData Source:=Range("'Feuille de calculs'!$X$13:$Y$65")
    Application.CutCopyMode = False
    ActiveChart.FullSeriesCollection(1).XValues = "='Feuille de calculs'!$X$13:$Y$65"
    ActiveChart.FullSeriesCollection(1).Values = "='Feuille de calculs'!$X$13:$X$65"
    ActiveChart.FullSeriesCollection(1).XValues = "='Feuille de calculs'!$Y$13:$Y$65"
 
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = "Graphique des pertes de charge du réseau aéraulique"
        With .Axes(xlValue, xlPrimary)
            .HasTitle = True
            .AxisTitle.Characters.Text = "Pression [Pa]"
        End With
        With .Axes(xlCategory, xlPrimary)
            .HasTitle = True
            .AxisTitle.Characters.Text = "Position [m]"
        End With
 
    End With
        'ActiveSheet.ChartObjects.Delete
End Sub
 
 
Function Find_Next(Rng As Range, texte As String, Tbl()) As Boolean
    Dim Nbre As Integer, Lig As Long, Cptr As Long
 
    Nbre = Application.CountIf(Rng, texte)
    If Nbre > 0 Then
        ReDim Tbl(Nbre - 1)
        Lig = 1
        For Cptr = 0 To Nbre - 1
            Lig = Rng.Find(texte, Cells(Lig, Rng.Column), xlValues).Row
            Tbl(Cptr) = Cells(Lig, Rng.Column).Address
        Next
    Else
        GoTo Absent
    End If
    Find_Next = True
    Exit Function
Absent:
    Find_Next = False
End Function