Création d'une courbe évolutive

Bonjour,

Je poste ce sujet car je cherche à faire une courbe évolutive mais je ne trouve pas le moyen. Actuellement j'ai un tableau d'archivage et donc il augmente en nombre de ligne chaque fois que je rentre de nouvelles données. J'ai une macro qui ,en appuyant sur un bouton fait apparaître une courbe, cependant j'ai rentré en X (Test3) et en Y(test4) une formule qui me permet de sélectionner la dernière cellule non vide de mon tableau mais la courbe n'apparaît pas en appuyant sur le bouton j'ai juste un point de la courbe qui ne correspond à rien.

Sub Courbe()

Dim feuille As Worksheet

Dim graphique As ChartObject

Set feuille = Sheets("Archive")

Set graphique = feuille.ChartObjects.Add(100, 100, 500, 300)

With graphique.Chart

  .ChartType = xlLineMarkers

  .SeriesCollection.NewSeries

  With .SeriesCollection(1)

    .Values = feuille.Range("F4").End(xlUp).Select

    .XValues = feuille.Range("E4").End(xlUp).Select

  End With

End With

Set graphique = Nothing

Set feuille = Nothing

End Sub

Voilà la macro que j'utilise pour faire apparaître ma courbe et voila le résultat que j'obtient

image

J'aimerai donc avoir la courbe qui apparaît en appuyant sur le bouton de la cellule E4 à la dernière cellule du tableau ( pour l'axe X) et de la cellule F4 à la dernière cellule du tableau (pour l'axe Y). En sachant que les données qui s'ajoute au tableau d'archive sont soit de 6 soit de 7 lignes à chaque fois.

Merci à vous.

bonjour,

une correction

Sub Courbe()

    Dim feuille As Worksheet

    Dim graphique As ChartObject

    Set feuille = Sheets("Archive")

    Set graphique = feuille.ChartObjects.Add(100, 100, 500, 300)

    With graphique.Chart

        .ChartType = xlLineMarkers

        .SeriesCollection.NewSeries

        With .SeriesCollection(1)

            .Values = feuille.Range(Range("F4"), Cells(Rows.Count, "F").End(xlUp))

            .XValues = feuille.Range(Range("E4"), Cells(Rows.Count, "E").End(xlUp))

        End With

    End With

    Set graphique = Nothing

    Set feuille = Nothing

End Sub

Cela marche comme ca super merci beaucoup. Savez-vous comment faire pour supprimer l'ancienne courbe via la macro ou vaut-il mieux continuer à la supprimer manuellement ?

re-bonjour,

Savez-vous comment faire pour supprimer l'ancienne courbe via la macro ou vaut-il mieux continuer à la supprimer manuellement ?

essaie ceci, Va créer le graphique si aucun graphique n'existe, sinon il va réutiliser le premier graphique créé.

Sub Courbe()

    Dim feuille As Worksheet

    Dim graphique As ChartObject

    Set feuille = Sheets("Archive")
    Set graphique = Nothing
    On Error Resume Next
    Set graphique = feuille.ChartObjects(1)
    On Error GoTo 0
    If graphique Is Nothing Then
        Set graphique = feuille.ChartObjects.Add(100, 100, 500, 300)
    End If

    With graphique.Chart
        .ChartType = xlLineMarkers
        If .SeriesCollection.Count = 0 Then
            .SeriesCollection.NewSeries
        End If

        With .SeriesCollection(1)
            .Values = feuille.Range(Range("F4"), Cells(Rows.Count, "F").End(xlUp))
            .XValues = feuille.Range(Range("E4"), Cells(Rows.Count, "E").End(xlUp))
        End With

    End With

    Set graphique = Nothing
    Set feuille = Nothing

End Sub

Parfait merci beaucoup !

Rechercher des sujets similaires à "creation courbe evolutive"