Заполнение коллекции серий диапазоном из другой книги

#excel #vba #excel-charts

#excel #vba #excel-диаграммы

Вопрос:

Я планирую пользовательскую форму, которая будет генерировать графики с использованием данных из других файлов. Я пытался заполнить seriescollection из диаграммы 1, используя данные из другой книги. Хотя моя программа вызывает пустоту seriescollection . Ниже приведен код для этой программы (некоторые части были вырезаны, потому что они не имеют отношения к проблеме).

 Dim ChtsBig(), openWb As Workbook, genWb As Workbook
Set genWb = ActiveWorkbook
If ListBox1.ListCount = 0 Then MsgBox ("Select files!")
ReDim Preserve ChtsBig(1 To ListBox1.ListCount)
For i = 1 To ListBox1.ListCount
    fileWb = ListBox1.List(i - 1, 1)
    Set openWb = Application.Workbooks.Open(Filename:=fileWb, ReadOnly:=True)
    Set sht1 = openWb.Worksheets(1)
    Set sht2 = openWb.Worksheets("Cycles")
    Set ChtsBig(i) = genWb.Charts.Add
    With ChtsBig(i)
        .Name = "Cell " amp; Left(ListBox1.List(i - 1, 0), 4)
        .ChartType = xlXYScatterSmoothNoMarkers
        j = 1
        k = 1
        For curr_cyc = TextBox7.Value To TextBox8.Value Step TextBox9.Value
            Do
                If sht2.Cells(1   j, 1) = curr_cyc Then
                    cyc_row = 1   j
                    found = True
                End If
                j = j   1
            Loop Until found = True Or sht2.Cells(2   j, 1) = Empty
            If found = True Then
                .SeriesCollection.NewSeries
                .SeriesCollection(k).Name = "Cycle " amp; curr_cyc amp; " Charge"
                .SeriesCollection(k).XValues = sht1.Range(sht1.Cells(3   sht2.Cells(cyc_row, 4), 16), sht1.Cells(3   sht2.Cells(cyc_row, 5), 16))
                .SeriesCollection(k).Values = sht1.Range(sht1.Cells(3   sht2.Cells(cyc_row, 4), 9), sht1.Cells(3   sht2.Cells(cyc_row, 5), 9))
                Numpoint1 = .SeriesCollection(k).Points.Count
                .SeriesCollection(k).Points(Numpoint1).MarkerStyle = xlMarkerStyleTriangle
                .SeriesCollection.NewSeries
                .SeriesCollection(k   1).Name = "Cycle " amp; curr_cyc   1 amp; " Discharge"
                .SeriesCollection(k   1).XValues = sht1.Range(sht1.Cells(3   sht2.Cells(cyc_row, 6), 16), sht1.Cells(3   sht2.Cells(cyc_row, 7), 16))
                .SeriesCollection(k   1).Values = sht1.Range(sht1.Cells(3   sht2.Cells(cyc_row, 6), 9), sht1.Cells(3   sht2.Cells(cyc_row, 7), 9))
                .SeriesCollection(k   1).MarkerStyle = xlMarkerStyleNone
                .SeriesCollection(k   1).Border.LineStyle = xlDash
                Numpoint2 = .SeriesCollection(k   1).Points.Count
                .SeriesCollection(k   1).Points(Numpoint2).MarkerStyle = xlMarkerStyleDiamond
                currentSeriesColorindex = (k   1) / 2   40
                If (k   1) / 2   40 < 57 Then
                    currentSeriesColorindex = (k   1) / 2   40
                Else
                    currentSeriesColorindex = (k   1) / 2   32
                End If
                .SeriesCollection(k).Points(Numpoint1).MarkerForegroundColorIndex = currentSeriesColorindex
                .SeriesCollection(k).Points(Numpoint1).MarkerBackgroundColorIndex = currentSeriesColorindex
                .SeriesCollection(k   1).Points(Numpoint2).MarkerForegroundColorIndex = currentSeriesColorindex
                .SeriesCollection(k   1).Points(Numpoint2).MarkerBackgroundColorIndex = currentSeriesColorindex
                .SeriesCollection(k   1).Border.ColorIndex = currentSeriesColorindex
                .SeriesCollection(k).Border.ColorIndex = currentSeriesColorindex
            End If
            found = False
            k = k   2
        Next
        .HasTitle = False
        .Axes(xlValue, xlPrimary).MinimumScale = 2.5
        .Axes(xlValue, xlPrimary).MaximumScale = 4.5
        .Axes(xlCategory, xlPrimary).MinimumScale = 0.0001
        .Axes(xlCategory).TickLabels.NumberFormat = "#0,0"
        .Axes(xlCategory).HasTitle = True
        .Axes(xlCategory).AxisTitle.Caption = "Charge / Ah"
        .Axes(xlValue).HasTitle = True
        .Axes(xlValue).AxisTitle.Caption = "Voltage / V"
        .Axes(xlCategory).AxisTitle.Font.Bold = False
        .Axes(xlValue).AxisTitle.Font.Bold = False
        .Legend.IncludeInLayout = False
        .Legend.Interior.Color = RGB(255, 255, 255)
        .Axes(xlCategory).HasMajorGridlines = True
        .Axes(xlCategory).MajorGridlines.Border.Color = RGB(160, 160, 160)
        .Axes(xlCategory).MajorGridlines.Border.LineStyle = xlDash
        .Axes(xlValue).MajorGridlines.Border.Color = RGB(160, 160, 160)
        .Axes(xlValue).MajorGridlines.Border.LineStyle = xlDash
    End With
    openWb.Close SaveChanges:=False
Next
  

При отладке этот диапазон: sht1.Range(sht1.Cells(3 sht2.Cells(cyc_row, 4), 16), sht1.Cells(3 sht2.Cells(cyc_row, 5), 16)) имеет правильные значения в Значении2, хотя .SeriesCollection(k).XValues и пуст.

После уточнения sht1 содержит необработанные данные для диаграммы, но разделенные на фрагменты (например, один набор данных находится между строками от 250 до 500). Sht2 содержит информацию о положении этих блоков.

Если это поможет, вот как должен выглядеть график:Сгенерированный график

Ответ №1:

Этот шаблон:

 If found = True Then
    .SeriesCollection.NewSeries
    .SeriesCollection(k).Name = "Cycle " amp; curr_cyc amp; " Charge"
  

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

 Dim s1 As Series

If found = True Then
    Set s1 = .SeriesCollection.NewSeries() 'get a reference on creation
    s1.Name = "Cycle " amp; curr_cyc amp; " Charge"
  

Также неплохо при добавлении новой диаграммы убедиться, что Excel не «автоматически добавил» какие-либо серии для вас, проверив SeriesCollection.Count , прежде чем вы начнете добавлять свою серию.

Комментарии:

1.Привет, спасибо, что подняли этот вопрос. Обычно я добавляю ChartArea.Clear после создания новой диаграммы. У вас есть какие-либо идеи, почему мой SeriesCollection(k) пуст после этого : .SeriesCollection(k).XValues = sht1.Range(sht1.Cells(3 sht2.Cells(cyc_row, 4), 16), sht1.Cells(3 sht2.Cells(cyc_row, 5), 16)) .SeriesCollection(k).Values = sht1.Range(sht1.Cells(3 sht2.Cells(cyc_row, 4), 9), sht1.Cells(3 sht2.Cells(cyc_row, 5), 9))

2. Я мог только догадываться, что в этом диапазоне нет данных, потому что либо листы, либо диапазоны ввода не соответствуют вашим ожиданиям.

3. Я проверил, и даже если я назначу sht1 Рабочему листу в другой книге, приведенное выше выражение ссылается на диапазон в книге, где был запущен макрос, а не на открытый с данными. Однако он правильно считывает значения из sht2.

4. Трудно понять, как это могло произойти — назначение sht1 кажется прекрасным. Единственное, что я мог видеть, что может быть проблемой, это то, что файл, который вы назначаете openWb, уже открыт, и в этом случае Excel имеет тенденцию назначать какой-либо другой открытый файл вместо ожидаемого. Если у вас все еще возникают проблемы, и вы можете поделиться своими книгами, я могу взглянуть — либо поделиться через box / dropbox / etc