Microsoft 365 créer un macro vba

[souhaib ad]

Bonjour,

Je souhaite modifier cette macro pour qu'elle trace 5 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 X5 As Double, Y5 As Double, X6 As Double, Y6 As Double
Dim X7 As Double, Y7 As Double, X8 As Double, Y8 As Double
Dim SerieX As Range
Dim SerieY As Range
Dim Cell As Range
Dim DerniereLigne As Long


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

' Ajouter le texte dans la cellule G22
Cells(22, "G").Value = "MAX DE DEFORMATION MAX"
' Ajouter le texte dans la cellule H22
Cells(22, "H").Value = "MIN DE DEFORMATION MAX"
' Ajouter le texte dans la cellule I22
Cells(22, "I").Value = "MAX DE DEFORMATION MAX"
' Ajouter le texte dans la cellule J22
Cells(22, "J").Value = "MIN DE DEFORMATION MAX"

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

' Calcul sur la cellule H23 : B14 - B14 * 0.01
Cells(23, "H").Value = Cells(11, "B").Value - Cells(11, "B").Value * 0.01
' Calcul sur la cellule I23 : B14 + B14 * 0.01
Cells(23, "I").Value = Cells(12, "B").Value + Cells(12, "B").Value * 0.01

' Calcul sur la cellule J23 : B14 - B14 * 0.01
Cells(23, "J").Value = Cells(12, "B").Value - Cells(12, "B").Value * 0.01


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

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

' Initialiser les coordonnées des points
X1 = ws.Cells(23, "B").Value
Y1 = ws.Cells(23, "G").Value
X2 = ws.Cells(ws.Rows.Count, "B").End(xlUp).Value
Y2 = ws.Cells(23, "G").Value
X3 = ws.Cells(23, "B").Value
Y3 = ws.Cells(23, "H").Value
X4 = ws.Cells(ws.Rows.Count, "B").End(xlUp).Value
Y4 = ws.Cells(23, "H").Value
X5 = ws.Cells(23, "B").Value
Y5 = ws.Cells(23, "I").Value
X6 = ws.Cells(ws.Rows.Count, "B").End(xlUp).Value
Y6 = ws.Cells(23, "I").Value
X7 = ws.Cells(23, "B").Value
Y7 = ws.Cells(23, "J").Value
X8 = ws.Cells(ws.Rows.Count, "B").End(xlUp).Value
Y8 = ws.Cells(23, "J").Value

' Parcourir les cellules de la colonne B
For Each Cell In ws.Range("C23:C" & DerniereLigne)

' Si la cellule est vide, passer à la cellule suivante
If Cell.Value = "" Or Not IsNumeric(Cell.Value) Then
GoTo NextCell
End If

' Si la cellule n'est pas vide, ajouter les valeurs aux séries
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

NextCell:

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 DE DEFORMATION MAX"
' Modifier la couleur et l'épaisseur de la ligne MAX
.Format.Line.ForeColor.RGB = RGB(255, 0, 0) ' Rouge
.Format.Line.Weight = 5 ' Épaisseur de la ligne
End With
.SeriesCollection.NewSeries
With .SeriesCollection(2)
.XValues = Array(X3, X4)
.Values = Array(Y3, Y4)
.ChartType = xlLine
.Name = "MIN DE DEFORMATION MAX"
' Modifier la couleur et l'épaisseur de la ligne MIN
.Format.Line.ForeColor.RGB = RGB(0, 255, 0) ' Vert
.Format.Line.Weight = 3 ' Épaisseur de la ligne
End With
.SeriesCollection.NewSeries
With .SeriesCollection(3)
.XValues = Array(X5, X6)
.Values = Array(Y5, Y6)
.ChartType = xlLine
.Name = "MAX DE DEFORMATION MIN"
' Modifier la couleur et l'épaisseur de la ligne MAX
.Format.Line.ForeColor.RGB = RGB(255, 0, 0) ' Rouge
.Format.Line.Weight = 5 ' Épaisseur de la ligne
End With
.SeriesCollection.NewSeries
With .SeriesCollection(4)
.XValues = Array(X7, X8)
.Values = Array(Y7, Y8)
.ChartType = xlLine
.Name = "MIN DE DEFORMATION MIN"
' Modifier la couleur et l'épaisseur de la ligne MIN
.Format.Line.ForeColor.RGB = RGB(0, 255, 0) ' Vert
.Format.Line.Weight = 3 ' Épaisseur de la ligne
End With
.SeriesCollection.NewSeries
With .SeriesCollection(5)
.XValues = SerieX
.Values = SerieY
.ChartType = xlXYScatter
.Name = "deformation"
' Modifier la couleur et la taille des nuages de points
.MarkerStyle = xlMarkerStyleCircle
.MarkerForegroundColor = RGB(0, 0, 255) ' Bleu
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 = "extenso %"


End With
End Sub