Создание динамических диаграмм с VBA

Question

Мне нужно создать почти 200 графиков временных рядов. Поэтому я попытался написать макрос, который завершает большую часть работы, которую мне нужно сделать.
я сгенерировал имена для временных рядов, как это в качестве примера:

Name:= AKB_ExampleA 

Названия относится к динамическому диапазону, который я объявленный с этой формулой:

=OFFSET('sheet1'!$C$7:$C$137;0;0;COUNT('sheet1'!$C$7:$C$206)) 

Так что теперь к макро я кодированной до сих пор:

Sub graphik_erstellen() 

Call graphik1("AKB") 

End Sub 

Sub graphik(Name As String) 
' 
    Dim Ch As Chart 
    Dim RngToCover As Range 
    Set Ch = charts.Add 
    Set Ch = Ch.Location(Where:=xlLocationAsObject, Name:="Charts") 

    With Ch 
     .ChartType = xlLine 
     .SetSourceData Source:=Range(Name & "_ExampleA") 
     .SeriesCollection(1).XValues = Range("Datum_Volumen") 
     .SeriesCollection(1).Name = "SERIES1" 
     .FullSeriesCollection(1).Select 
     With Selection.Format.Line 
      .Visible = msoTrue 
      .ForeColor.RGB = RGB(192, 0, 0) 
      .Transparency = 0 
     End With 
     .HasTitle = True 
     .ChartTitle.Text = Name & ", Volumen (nach Korrektur)" 
     .HasLegend = True 
     .Legend.Position = xlLegendPositionBottom 
     .Legend.Select 
     Selection.Format.TextFrame2.TextRange.Font.Size = 11 
     Selection.Format.TextFrame2.TextRange.Font.Bold = msoTrue 
     With .Parent 
     .top = 100 
     .left = 100 
     .height = 287.149606299 
     .width = 543.685039370078 
     .Name = Name & "_chart" 
     End With 
End With 

End Sub 

Моя проблема в том, что если я это сделаю, динамический диапазон на самом деле не рассматривается. Он принимает диапазон имени (который равен $ C $ 7: $ C $ 137), но он должен ссылаться на само имя (для того, чтобы быть динамическим).
Так что, если я нажму на диаграмму, чтобы увидеть серию, значения серии будут объявлены как: ='sheet1'!$C$7:$C$137 вместо ='sheet1'!ExampleA.

Я был бы очень, очень благодарен, если бы кто-нибудь мог мне помочь. Best Elio

Answer 1

Я перестроил несколько строк кода и попытался разместить комментарии, ссылаясь на них.

Дайте мне знать, что работает. Вам может потребоваться изменить SeriesCollection на FullSeriesCollection. Кроме этого код работает в моем Excel 2010.

Первый Sub я просто получить Range размер согласно данным, имеющимся в Column «C» от ​​ 7.

Позвольте мне знать.

Option Explicit 

Sub graphik_erstellen() 

    'You always want to use direct reference to a sheet/range chart 
    'Refering to the WorkBook they are in and the worksheet as well. 
    'especially if you are opening multiple WorkBooks/Sheets 
    Dim CurrentWorkSheet As Worksheet 
    Set CurrentWorkSheet = Workbooks("Book1").Worksheets("Sheet1") 

    'Dynamically finding the end of the data in Column C 
    Dim LastRow As Long 
    LastRow = CurrentWorkSheet.Cells(CurrentWorkSheet.Rows.Count, "C").End(xlUp).Row 

    'Setting the range using the document reference aswell 
    Dim AKB As Range 
    Set AKB = Workbooks("Book1").Worksheets("Sheet1").Range(Cells(7, "C"), Cells(LastRow, "C")) 


    Call graphik(AKB) 

End Sub 

Sub graphik(Name As Range) 

    Dim DataChart As Chart 
    Dim RngToCover As Range 
    Set DataChart = Workbooks("Book1").Charts.Add 

    'With Excel 2010 the line above will automatically add the chart as a sheet and not aobject in a sheet 
    'Set DataChart = DataChart.Location(Where:=xlLocationAsObject, Name:="Charts") 


    With DataChart 
     .Name = "Charts" ' This will be the Name of the CHart Tab 
     .ChartType = xlLine 
     .SetSourceData Source:=Name 

     'You can see below I avoided the Select and Selection 
     With .SeriesCollection(1) 
      'Using Offset I just used the data one cell to the left of the range 
      .XValues = Name.Offset(0, -1) 
      .Name = "SERIES1" 
      With .Format.Line 
       .Visible = msoTrue 
       .ForeColor.RGB = RGB(192, 0, 0) 
       .Transparency = 0 
      End With 
     End With 

     .HasTitle = True 
     .ChartTitle.Text = "MIDDEL TOP TEXT" 'Name & ", Volumen (nach Korrektur)" 
     .HasLegend = True 
     With .Legend 
      .Position = xlLegendPositionBottom 
      .Format.TextFrame2.TextRange.Font.Size = 11 
      .Format.TextFrame2.TextRange.Font.Bold = msoTrue 
     End With 

     'Not sure about this, it doesnt work in my Excel 2010 
     ' 
     With .Parent 
      .Top = 100 
      .Left = 100 
      .Height = 287.149606299 
      .Width = 543.685039370078 
      .Name = Name & "_chart" 
     End With 

    End With 

End Sub 

Позвольте мне знать, что ваши намерения для названия листов и диаграммы, а затем я могу помочь с получением что, что вам нужно, а также.