Question

我有一个VBA脚本，可用于在Excel中生成多个折线图。它过去每个图表包括2个系列集合（从2列读取），但是我此后仅对其进行了修改。但是，现在我希望它再次执行2系列操作，但希望它从同一列中读取两个集合。这可能吗？

我尝试修改.SeriesCollection（2）以转到该列下方的下一个范围。但是，这只会返回错误4001。

Sub CreateCharts()
    Dim ws As Worksheet
    Dim ch As Chart
    Dim NumCharts As Integer, ChartName As String, ChartTitle As String, i  As Integer

    Set ws = Sheets("Charts")

    NumCharts = WorksheetFunction.CountA(ws.Rows(2))

    For i = 2 To NumCharts Step 1 '1 column of data per chart
        ChartName = ws.Cells(2, i) '"chrt" & Range(Col1 & 2)
        ChartTitle = ws.Cells(2, i) 'Range(Col1 & 2)
        Set ch = Charts.Add
        With ch
            .ChartType = xlLine
            .SetSourceData Source:=ws.Range(ws.Cells(3, i), ws.Cells(20, i)), _
            PlotBy:=xlColumns 'range of data for each chart
            .SeriesCollection(1).XValues = ws.Range("A3:A20") 'data range of line 1 (test data)
            .SeriesCollection(2).XValues = ws.Range("A21:A38") 'data range of line 2 (Rw curve)
            .Name = ChartName
            .HasTitle = True
            .ChartTitle.Characters.text = "#" & ws.Cells(2, i) '& " " & ws.Cells(1, i)  'remove title 'change to "ws.Cells(2, i)" to see titles
            .ChartTitle.Left = 600

            'HORiZONTAL X AXiS
            .Axes(xlCategory, xlPrimary).HasTitle = True
            .Axes(xlCategory, xlPrimary).AxisTitle.Characters.text = "Frequency (Hz)"
            .Axes(xlCategory).MajorTickMark = xlNone
            .Axes(xlCategory).AxisBetweenCategories = False
            .Axes(xlCategory).Border.LineStyle = None

            'VERTiCAL Y AXiS
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.text = "Sound Reduction Index (dB)"
            .Axes(xlValue).TickLabels.NumberFormat = "0"
            .Axes(xlValue).MajorTickMark = xlNone
            .Axes(xlValue).HasMajorGridlines = False
            .Axes(xlValue).MinimumScale = 10 'minimum value on y
            .Axes(xlValue).MaximumScale = 80 'maximum value on y
            .Axes(xlValue).Border.LineStyle = None

            'LEGEND
            .HasLegend = False

            'FONT SPECiFiCATiONS
            .ChartArea.Format.TextFrame2.TextRange.Font.Size = 14
            .ChartArea.Format.TextFrame2.TextRange.Font.Name = "Myriad Pro"
            .ChartArea.Border.LineStyle = xlNone

            'CHART POSiTiON, SiZE & COLOUR
            .PlotArea.Format.Fill.ForeColor.RGB = RGB(242, 242, 242) 'grey background
            .PlotArea.Top = 0
            .PlotArea.Left = 20
            .PlotArea.Height = 440
            .PlotArea.Width = 420

            'CHART LiNE COLOURS
            .SeriesCollection(1).Border.Color = RGB(27, 117, 188) 'first line colour
            '.SeriesCollection(2).Border.Color = RGB(0, 0, 0) 'second line colour
            '.SeriesCollection(2).LineStyle = xlDashDot

        End With
    Next i

End Sub

这是我想要实现的图像示例。

Answer 1

对代码进行了稍微的修改和测试，以达到我对目标的理解（每列创建一个2系列图表。第一系列第3-20行，第二系列第21至38行）。唯一的代码问题是缺少SeriesCollection(2)。对其进行了修改，以添加必要的SeriesCollection并删除（如果存在任何自动添加的系列集合）。

For i = 2 To NumCharts Step 1 '1 column of data per chart
        ChartName = ws.Cells(2, i) '"chrt" & Range(Col1 & 2)
        ChartTitle = ws.Cells(2, i) 'Range(Col1 & 2)
        Set ch = Charts.Add

            'Delete if any automatically added series exist
            For x = ch.SeriesCollection.Count To 1 Step -1
            ch.SeriesCollection(x).Delete
            Next

        With ch
            .ChartType = xlLine
            .SeriesCollection.Add ws.Range(ws.Cells(3, i), ws.Cells(20, i))
            .SeriesCollection.Add ws.Range(ws.Cells(21, i), ws.Cells(38, i))
            .SeriesCollection(1).XValues = ws.Range(ws.Cells(3, 1), ws.Cells(20, 1))
            .SeriesCollection(2).XValues = ws.Range(ws.Cells(21, 1), ws.Cells(38, 1))

            .Name = ChartName

Excel-使用同一列生成多个系列折线图

1 个答案: