XL 2021 macro VBA excel

[souhaib ad]

Bonjour,

Je souhaite modifier cette macro pour qu'elle trace trois séries sur la même échelle d'axe X et d'axe Y.

Sub CalculEtPlacement()
Dim ws As Worksheet
Dim chartObj As ChartObject
Dim X1 As Double, Y1 As Double, X2 As Double, Y2 As Double
Dim X3 As Double, Y3 As Double, X4 As Double, Y4 As Double
Dim SerieX As Range
Dim SerieY As Range
Dim Cell As Range
Dim DerniereLigne As Long

' Ajouter le texte dans la cellule G22
Cells(22, "G").Value = "MAX"
' Ajouter le texte dans la cellule H22
Cells(22, "H").Value = "MIN"

' Calcul sur la cellule G23 : B14 + B14 * 0.01
Cells(23, "G").Value = Cells(14, "B").Value + Cells(14, "B").Value * 0.01

' Calcul sur la cellule H23 : B14 - B14 * 0.01
Cells(23, "H").Value = Cells(14, "B").Value - Cells(14, "B").Value * 0.01

'Définir la feuille de calcul active
Set ws = ThisWorkbook.ActiveSheet

'Définir la dernière ligne de données
DerniereLigne = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row

'Initialiser les coordonnées des points
X1 = ws.Cells(23, "E").Value
Y1 = ws.Cells(23, "G").Value
X2 = ws.Cells(ws.Rows.Count, "E").End(xlUp).Value
Y2 = ws.Cells(23, "G").Value
X3 = ws.Cells(23, "E").Value
Y3 = ws.Cells(23, "H").Value
X4 = ws.Cells(ws.Rows.Count, "E").End(xlUp).Value
Y4 = ws.Cells(23, "H").Value

'Initialiser les séries de données
For Each Cell In ws.Range("F23:F" & DerniereLigne)
If Cell.Value <> "" And IsNumeric(Cell.Value) Then
If SerieX Is Nothing Then
Set SerieX = Cell.Offset(0, -1)
Set SerieY = Cell
Else
Set SerieX = Union(SerieX, Cell.Offset(0, -1))
Set SerieY = Union(SerieY, Cell)
End If
End If
Next Cell

'Créer un nouvel objet graphique
Set chartObj = ws.ChartObjects.Add(Left:=100, Width:=375, Top:=75, Height:=225)

'Ajouter les séries de données pour tracer les lignes
With chartObj.Chart
.SeriesCollection.NewSeries
With .SeriesCollection(1)
.XValues = Array(X1, X2)
.Values = Array(Y1, Y2)
.ChartType = xlLine
.Name = "MAX"
End With
.SeriesCollection.NewSeries
With .SeriesCollection(2)
.XValues = Array(X3, X4)
.Values = Array(Y3, Y4)
.ChartType = xlLine
.Name = "MIN"
End With
.SeriesCollection.NewSeries
With .SeriesCollection(3)
.XValues = SerieX
.Values = SerieY
.ChartType = xlXYScatter
.Name = "TEMPERATURE"
End With


'Activer les titres des axes
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).HasTitle = True

'Définir le texte des titres des axes
.Axes(xlCategory, xlPrimary).AxisTitle.Text = "CYCLE"
.Axes(xlValue, xlPrimary).AxisTitle.Text = "TEMPERATURE °C"
End With
End Sub

 

[crocrocro]

Bonjour,
pour augmenter les chances d'avoir des réponses, il est préférable de fournir également un fichier.