Allègement Code VBA Graphique

Bonsoir à tous,

J'ai réalisé un petit code permettant de mettre en forme une série de données sous la forme d'un graphique.

La particularité de ce graphique et de colorer les points le composant dès que ceux-ci dépassent une certaine valeur (par exemple, si valeur < seuil 25 : couleur bleu ; si > 25 : couleur rouge).

Quand j'ai fait les tests sur une petite base de donnée (environ 2500 lignes), le code fonctionnait sans problème. En revanche sur des bases de données plus grandes (environ 50 000 lignes), le code plante à la mise en forme finale ...

Ainsi, auriez-vous une solution pour réaliser la même tâche mais "allegée" ?

Pour essayer de faciliter la comprehension, le code est décomposée en 3 étape :

La première, effectue quelques calculs qui me seront utiles pour d'autres macros; et définit également le "seuil" de changement de couleur

La deuxième étape, créer un graphique "basique", en vu de la mise en forme

La 3ème étape change la couleur des points du graphique supérieur à la valeur seuil. Pour cela je réalise une boucle sur chaque point.

Sub MAV()

Dim MAV As Double

Cells(1, 11).Value = "Marche pleine"
Cells(1, 12).Value = "Marche a vide"
Cells(1, 13).Value = "Seuil MAV/MP déterminé"
Columns("L:L").AutoFit
Cells(1, 14).Value = InputBox("Choix intensité seuil bascule MP/MAV ?")
Cells(1, 14).NumberFormat = "0.00" & " A"
MAV = Cells(1, 14)
'Temps de MAV

nb_rows = Cells(Cells.Rows.Count, 1).End(xlUp).Row 'Compter le nb de ligne de la feuille

For i = 2 To nb_rows

If Cells(i, 9) >= MAV Then
    Cells(i, 12).Value = Cells(i, 9)
    Cells(1, 12).NumberFormat = "0.00"

ElseIf Cells(i, 9) < MAV Then
    Cells(i, 11).Value = Cells(i, 9)
    Cells(1, 11).NumberFormat = "0.00"

End If

Next

'CREA GRAPHIQUE

nb_rows = Cells(Cells.Rows.Count, 1).End(xlUp).Row
MiniOrdo = WorksheetFunction.Min(Range(Cells(1, 9), Cells(nb_rows, 9)))
MaxiOrdo = WorksheetFunction.Max(Range(Cells(2, 9), Cells(nb_rows, 9))) + 5
    Application.ScreenUpdating = False

    Union(Range(Cells(1, 1), Cells(nb_rows, 1)), Range(Cells(1, 9), Cells(nb_rows, 9))).Select
    Set Graphique = ActiveSheet.Shapes.AddChart2(240, xlXYScatterLinesNoMarkers)

    Graphique.Chart.ChartTitle.Text = "Détail MAV et PM " & Cells(1, 9)
    Graphique.Chart.ChartTitle.Font.Name = "Tahoma"
    Graphique.Chart.ChartTitle.Font.Bold = True

    Graphique.Chart.Axes(xlCategory).HasTitle = True 'titre
    Graphique.Chart.Axes(xlCategory).AxisTitle.Text = "Période de mesure" 'nom titre
    Graphique.Chart.Axes(xlCategory).TickLabels.Font.Name = "Tahoma" 'police axe
    Graphique.Chart.Axes(xlCategory).TickLabels.Font.Size = 7 'taille police axe
    Graphique.Chart.Axes(xlCategory).AxisTitle.Font.Name = "Tahoma" 'police titre
    Graphique.Chart.Axes(xlCategory).TickLabels.NumberFormat = "dd/mm - hh:mm"
    Graphique.Chart.Axes(xlCategory).AxisTitle.Font.Bold = True 'gras titre
    Graphique.Chart.Axes(xlCategory).MinimumScale = Cells(2, 1)
    Graphique.Chart.Axes(xlCategory).MaximumScale = Cells(nb_rows, 1)

    Graphique.Chart.Axes(xlValue).HasTitle = True
    Graphique.Chart.Axes(xlValue).AxisTitle.Text = "Intensité(A)"
    Graphique.Chart.Axes(xlValue).AxisTitle.Font.Bold = True
    Graphique.Chart.Axes(xlValue).TickLabels.Font.Name = "Tahoma" 'police axe
    Graphique.Chart.Axes(xlValue).TickLabels.Font.Size = 7 'taille police axe
    Graphique.Chart.Axes(xlValue).MinimumScale = MiniOrdo
    Graphique.Chart.Axes(xlValue).MaximumScale = MaxiOrdo
    Graphique.Chart.Axes(xlValue).TickLabels.NumberFormat = 0

    Graphique.Chart.ChartArea.Width = 510
    Graphique.Chart.ChartArea.Height = 226

    Graphique.Fill.Visible = msoFalse

' MISE EN FORME COULEUR SEUIL

With Graphique.Chart.SeriesCollection(1)
For i = 1 To .Points.Count
Pts = .Values
If Pts(i) < MAV Then
    .Points(i).Format.Line.ForeColor.RGB = RGB(26, 127, 193)
Else
    .Points(i).Format.Line.ForeColor.RGB = RGB(193, 26, 61)

End If

Next
End With

    Graphique.Chart.FullSeriesCollection(1).Format.Line.Weight = 0.25
    Graphique.Chart.FullSeriesCollection(1).Format.Shadow.Type = msoShadow22

End Sub

Je ne peux joindre le fichier qui est trop lourd. Je pourrais en revanche le transmettre par wetransfer si besoin

En vous remerciant !