[VBA] Création de plusieurs graphes simultanéments

Sub Niarkniark()


Dim plage As Range
Dim Cell As Range
Dim i As Integer
Dim NombreDePlage As Integer
Dim premiereCaseNom As Range
Dim DerniereCaseNom As Range
Dim NomPlage() As String
ReDim NomPlage(1 To 1)
Dim NumeroDerniereLigne() As Integer
ReDim NumeroDerniereLigne(1 To 1)
Dim NumeroPremiereLigne()
ReDim NumeroPremiereLigne(1 To 1)


Set plageNom = Range("D4", Range("D4").End(xlDown))
Set plagedate = Range("C4", Range("C4").End(xlDown))

Range("C4", Range("E4").End(xlDown)).Sort Key1:=Range("D4"), Order1:=xlAscending



NombreDePlage = 0
For Each Cell In plageNom
If Cell <> Cell.Offset(1, 0) Then
NombreDePlage = NombreDePlage + 1
End If
Next Cell

Range("C4", Range("E4").End(xlDown)).Sort Key1:=Range("C4"), Order1:=xlAscending

'Next Cell


Range("C4", Range("E4").End(xlDown)).Sort Key1:=Range("D4"), Order1:=xlAscending

Set premiereCaseNom = Worksheets("Feuil1").Range("D4")
Set DerniereCaseNom = Worksheets("Feuil1").Range("D4", Range("D4").End(xlDown))

For Each Cell In Range(premiereCaseNom, DerniereCaseNom)
Cell.Select
If Cell <> Cell.Offset(1, 0) Then
NomPlage(UBound(NomPlage)) = Cell.Value
NumeroDerniereLigne(UBound(NumeroDerniereLigne)) = Cell.Row
ReDim Preserve NomPlage(1 To UBound(NomPlage) + 1)
ReDim Preserve NumeroDerniereLigne(1 To UBound(NumeroDerniereLigne) + 1)

End If
Next Cell

NumeroPremiereLigne(1) = 4
For i = 2 To UBound(NomPlage) – 1
ReDim Preserve NumeroPremiereLigne(1 To UBound(NumeroPremiereLigne) + 1)
NumeroPremiereLigne(i) = NumeroDerniereLigne(i - 1) + 1
Next i

For i = 1 To UBound(NomPlage) - 1
Charts.Add
ActiveChart.ChartType = xlLineMarkers
ActiveChart.SetSourceData Source:=Sheets("Feuil1").Range("H16")


ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(i).XValues = "=Feuil1!R" & NumeroPremiereLigne(i) & "C3:R" & NumeroDerniereLigne(i) & "C3"
ActiveChart.SeriesCollection(i).Values = "=Feuil1!R" & NumeroPremiereLigne(i) & "C5:R" & NumeroDerniereLigne(i) & "C5"
ActiveChart.SeriesCollection(i).Name = NomPlage(i)


ActiveChart.Location Where:=xlLocationAsObject, Name:="Feuil1"

Next i

End Sub

Cliquez pour agrandir...