Sélection de cellule pour macro de creation de graphique

Bonjour à tous,

J'ai un tableau avec trois colonne X, Y1, Y2 et Y3. J'ai écris une macro VBA capable de me tracer deux graphiques avec X;Y1 et Y2 et X;Y3. Jusque là, pas de soucis. Je cherche maintenant le moyen pour que le graphique X;Y3 soit tracé uniquement pour les valeurs correspondante de Y1 < -8

Voici le code :

Sub Graph()
'
' Graph Macro
'
' Touche de raccourci du clavier: Ctrl+w
'
    ActiveSheet.Shapes.AddChart.Select
    With ActiveChart
        .ChartType = xlXYScatterSmoothNoMarkers
        .SeriesCollection.NewSeries
        .SeriesCollection(1).Name = ActiveSheet.Range("$B$1")
        .SeriesCollection(1).XValues = ActiveSheet.Range("$A$2:$A$32000")
        .SeriesCollection(1).Values = ActiveSheet.Range("$B$2:$B$32000")
        .SeriesCollection.NewSeries
        .SeriesCollection(2).Name = ActiveSheet.Range("$C$1")
        .SeriesCollection(2).XValues = ActiveSheet.Range("$A$2:$A$32000")
        .SeriesCollection(2).Values = ActiveSheet.Range("$C$2:$C32000")
        .Axes(xlValue).Select
        .Axes(xlValue).MinimumScale = -20
        .Axes(xlValue).MaximumScale = 0
        .Axes(xlCategory).Select
        .Axes(xlCategory).MinimumScale = 0
        .Axes(xlCategory).MaximumScale = 2500
    End With
    ActiveSheet.Shapes.AddChart.Select
    With ActiveChart
        .ChartType = xlXYScatterSmoothNoMarkers
        .SeriesCollection.NewSeries
        .SeriesCollection(1).Name = ActiveSheet.Range("$D$1")
        .SeriesCollection(1).XValues = ActiveSheet.Range("$A$2:$A$32000")
        .SeriesCollection(1).Values = ActiveSheet.Range("$D$2:$D$32000")
        .Axes(xlValue).Select
        .Axes(xlValue).MinimumScale = -1
        .Axes(xlValue).MaximumScale = 1
        .Axes(xlCategory).Select
        .Axes(xlCategory).MinimumScale = 0
        .Axes(xlCategory).MaximumScale = 2500
    End With
    ActiveSheet.ChartObjects(1).Left = Range("F2").Left
    ActiveSheet.ChartObjects(1).Top = Range("F2").Top
    ActiveSheet.ChartObjects(2).Left = Range("F19").Left
    ActiveSheet.ChartObjects(2).Top = Range("F19").Top
End Sub

Et si possible, je souhaiterais que ce code s'applique automatiquement à la totalité des feuilles de mon classeur, feuilles qui portent des nom différents.

Je joints également une des feuilles.

Merci à tous ceux qui prendront un peu de temps pour me faire partager leur expérience.

Nico

Bonjour,

Au plus simple, tu crées une colonne Y3' avec la formule :

=SI(B2<-8;D2;NA())

A recopier...

Et tu modifies la colonne dans ta macro.

Cdlt.

Merci pour ta réponse, en effet, ça supprime bien toute les valeurs supérieurs à -8. Toutefois, comment faire pour que l'axe des X sur le graphique commence à la première valeur réelle ?

Merci beaucoup de votre aide !

Re,

La suite.

Ctrl + w pour lancer la procédure

(*) Effacer manuellement le graphique avant de lancer la procédure

(**) je te laisse réfléchir à la mise en forme de l'axe des abscisses

(***) idée : revoir le type de graphique??

A te relire

Option Explicit
' Ctrl + w
' pour lancer la procédure
Public Sub test()
Dim ws As Worksheet
Dim rng As Range, rngX As Range, rngY As Range
Dim lastRow As Long

    Application.ScreenUpdating = False
    Set ws = ActiveSheet

    With ws

        lastRow = .Range("A" & Rows.Count).End(xlUp).Row

        Set rng = .Range(.Cells(2, 5), .Cells(lastRow, 5))
        Set rngX = rng.SpecialCells(xlCellTypeFormulas, 1)

        Set rng = .Range(.Cells(2, 6), .Cells(lastRow, 6))
        Set rngY = rng.SpecialCells(xlCellTypeFormulas, 1)

        .Shapes.AddChart.Select
        With ActiveChart
            .ChartType = xlXYScatterSmoothNoMarkers
            .HasLegend = False
            .SeriesCollection.NewSeries
            .SeriesCollection(1).Name = ActiveSheet.Range("$F$1")
            .SeriesCollection(1).XValues = rngX
            .SeriesCollection(1).Values = rngY
            .Axes(xlValue).MinimumScale = -1
            .Axes(xlValue).MaximumScale = 1
            .Axes(xlCategory).MinimumScale = Application.Min(rngX)
            .Axes(xlCategory).MaximumScale = Application.Max(rngX)
        End With
        .ChartObjects(1).Left = Range("I4").Left
        .ChartObjects(1).Top = Range("I4").Top

    End With

    Set ws = Nothing
    Set rng = Nothing: Set rngX = Nothing: Set rngY = Nothing

End Sub