Excel VBA Code permettant la création de nuage de point avec boucle

Question

J'essaie depuis 2j de créer un VBA permettant la création de graphe sur plusieurs pages : Chaque page de mon tableur est composé d'un tableau identique, avec des valeurs différentes. Mon code est le suivant : Sub GraphesIntervalles() ' ' GraphesIntervalles Macro ' Dim KV40 As Worksheet For i = 1 To Worksheets.Count ActiveSheet.Shapes.AddChart2(240, xlXYScatter).Select ActiveChart.SeriesCollection.NewSeries ActiveChart.FullSeriesCollection(1).XValues = "'KV40'!$E$2:$E$15" 'KV40 est le nom de ma première page. ActiveChart.FullSeriesCollection(1).Values = "'KV40'!$Z$2:$Z$15" ActiveChart.SeriesCollection.NewSeries ActiveChart.FullSeriesCollection(2).XValues = "'KV40'!$E$2:$E$15" ActiveChart.FullSeriesCollection(2).Values = "'KV40'!$AA$2:$AA$15" ActiveChart.SeriesCollection.NewSeries ActiveChart.FullSeriesCollection(3).XValues = "'KV40'!$E$2:$E$15" ActiveChart.FullSeriesCollection(3).Values = "'KV40'!$X$2:$X$15" ActiveChart.SeriesCollection.NewSeries ActiveChart.FullSeriesCollection(4).XValues = "'KV40'!$E$2:$E$15" ActiveChart.FullSeriesCollection(4).Values = "'KV40'!$Y$2:$Y$15" ActiveChart.SeriesCollection.NewSeries ActiveChart.FullSeriesCollection(5).XValues = "'KV40'!$E$2:$E$15" ActiveChart.FullSeriesCollection(5).Values = "'KV40'!$AB$2:$AB$15" ActiveChart.SeriesCollection.NewSeries ActiveChart.FullSeriesCollection(6).XValues = "'KV0'!$E$2:$E$15" ActiveChart.FullSeriesCollection(6).Values = "'KV40'!$L$2:$L$15" Next i End Sub Cependant j'ai deux problèmes que je n'arrive pas à résoudre : - Ce code créer autant de graphes que j'ai de pages, mais sur ma première page, c'est bien mais ça n'est pas ce que je veux :( - Je ne sais pas comment faire pour insérer dans les données du graphe le nom de la page active... Merci par avance pour votre aide, n'hésitez pas si vous avez besoin de plus d'information, Florian...

Kilian1906 · Accepted Answer

Florian,

Essaye d'adapté ceci :

Option Explicit
Dim i%, DerL%
Dim ws As Worksheet
Sub GraphesIntervalles()
' GraphesIntervalles Macro
    On Error Resume Next ' Evite un bug si il n'y a pas de graphique sur la feuille
    For Each ws In ActiveWorkbook.Sheets
        ws.ChartObjects(1).Delete ' Supprime le graphique si il y en a un
        ws.Shapes.AddChart2(240, xlXYScatter).Select ' Ajoute un graphique
        For i = 2 To 7 ' de la ligne 2 à 7 (à adapter)
    DerL = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row ' Dernière cellule de la ligne A "No"
            With ActiveChart
                .SeriesCollection.NewSeries
                .SeriesCollection().XValues = Range(Cells(2, i), Cells(DerL, i)) ' A adpté
                .SeriesCollection().Values = Range(Cells(1, i), Cells(DerL, i)) ' A adapté
            End With
        Next i
    Next
End Sub

A+,

Kilian

Kilian1906 · Answer

Peux-tu joindre un fichier à ta demande pour que l'on puisse mieux se représenter ce que tu essai de faire. Si on ne sait pas ce que tu veux c'est compliqué de résoudre ton problème.. ActiveSheet.ChartObjects("Graphique 1").SetSourceData Source:=sheets("TaSource").Range("E2:E15") A+, Kilian...

Kilian1906 · Answer

As-tu pu tester ? A+, Kilian...