1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64
   | Sub LineCharts()
    Dim ws As Worksheet
    Dim bd As Worksheet
    Dim cht As ChartObject
    Dim LastRow As Long
    Dim CurrRow As Long
    Dim i As Integer
    Dim k As Integer
 
    Application.DisplayAlerts = False
 
    For Each ws In ActiveWorkbook.Worksheets
 
                        If ws.Name = "Graphiques" Then ws.Delete
 
    Next ws
 
    ActiveWorkbook.Worksheets.Add After:=Sheets(Sheets.Count)
 
    Sheets(Sheets.Count).Name = "Graphiques"
 
    Set ws = ThisWorkbook.Worksheets("Graphiques")
    Set bd = ThisWorkbook.Worksheets("Base de données")
 
    ActiveWorkbook.Worksheets("Base de données").Select
 
    i = 2
 
    k = 1
 
    Do Until Cells(1, k).Value = ""
 
    Do Until Cells(i, k).Value = ""
                                    i = i + 1
    Loop
 
    Worksheets("Graphiques").Select
 
 
    Set cht = ActiveSheet.ChartObjects.Add(Left:=250, Width:=375, Top:=75 + 10 * k, Height:=225)
 
    cht.Name = "chart"
 
        With cht
            .ChartType = xlLine
            .SeriesCollection(1).Name = bd.Range(Cells(1, k))
            .SeriesCollection(1).Values = bd.Range(Cells(2, k), Cells(i, k))
            .SeriesCollection(1).XValues = bd.Range(Cells(2, k + 1), Cells(i, k + 1))
            .Location Where:=xlLocationAsObject, Name:=ws.Name
 
        End With
 
        With ActiveChart.Axes(xlValue).TickLabels
        .Font.Bold = True
        .NumberFormat = "0.0"
        End With
 
    k = k + 3
 
    Loop
 
Application.DisplayAlerts = True
 
End Sub | 
Partager