无法为VBA/Excel按行绘制折线图

Question

在开始我的问题之前：我已经尝试了此社区中可用的公认解决方案（使用VBA excel（动态行、列）为每行创建折线图，并使用excel中的VBA宏为每行创建新图表）。对于这两种情况，我的图表都是用假设数据列的每一行创建的。

所以我有一个数据表，它通常具有从A1到F12的值。A列包含属性名称，如净利润、销售额、成本等，其时间进度图将被绘制。B2到F2行包含年份值。数据区域从B3到F12包含值。简而言之，每一行都是该特定属性的变化趋势。我想创建一个折线图来显示这种趋势（折线图中的每一行代表特定行中的值）。

我能够录制一个宏来做这件事

    Worksheets("CashFlow").Activate
    Range("B5:F7").Select
    ActiveSheet.Shapes.AddChart2(227, xlLineMarkers).Select
    ActiveChart.SetSourceData Source:=Range("'CashFlow'!$B$5:$F$7")
    ActiveSheet.Shapes("Chart 1").IncrementLeft -26.25
    ActiveSheet.Shapes("Chart 1").IncrementTop 133.5
    ActiveWindow.ScrollRow = 2
    ActiveWindow.SmallScroll Down:=5
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.Axes(xlCategory).ReversePlotOrder = True
    Application.CommandBars("Format Object").Visible = False
    ActiveChart.SetElement (msoElementPrimaryValueAxisTitleAdjacentToAxis)
    ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Text = "Cash (In Cr)"
    Selection.Format.TextFrame2.TextRange.Characters.Text = "Cash (In Cr)"
    With Selection.Format.TextFrame2.TextRange.Characters(1, 12).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 4).Font
        .BaselineOffset = 0
        .Bold = msoFalse
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(89, 89, 89)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 10
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(5, 8).Font
        .BaselineOffset = 0
        .Bold = msoFalse
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(89, 89, 89)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 10
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    ActiveChart.ChartArea.Select
    ActiveChart.SetElement (msoElementChartTitleNone)
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    ActiveChart.FullSeriesCollection(1).XValues = "='CashFlow'!$B$2:$F$2"

然而，当我通过宏调用（VBA）实际运行此程序时，它是按列绘制的。

类似地，当我使用它们的代码片段时，上面链接的两个答案也按列绘制了图表。如何编写VBA子过程，通过假设数据是按行的方式绘制折线图。

Answer 1

试试这个：

ActiveChart.SetSourceData Source:=Range("'CashFlow'!$B$5:$F$7"), PlotBy:=xlRows

Answer 2

我还不能确定你的意图，但这里有一个例子。

Sub test()
    Dim Ws As Worksheet
    Dim rngDB As Range
    Dim rngX As Range, rngY As Range
    Dim i As Integer
    Dim l As Single, t As Single
    Dim w As Single, h As Single
    Dim objChart As ChartObject
    
    Set Ws = Sheets("CashFlow")
    
    For Each objChart In Ws.ChartObjects
        objChart.Delete
    Next objChart
    
    Set rngDB = Ws.Range("a2")
    
    l = 1 'left
    t = Ws.Range("a14").Top 'top
    w = 400 'width
    h = 200      'height
    
    For i = 1 To 10
        Set rngX = rngDB.Offset(0, 1).Resize(1, 5)
        Set rngY = rngDB.Offset(i, 1).Resize(1, 5)
        addmyCharts Ws, rngX, rngY, l, t, w, h
        t = t + h
    Next i
    
End Sub


Private Sub addmyCharts(Ws As Worksheet, rngX As Range, rngY As Range, l As Single, t As Single, w As Single, h As Single)
    Dim shp As Shape
    Dim Cht As Chart
    Dim Srs As Series
    
    Set shp = Ws.Shapes.AddChart(xlLineMarkers, l, t, w, h)
    Set Cht = shp.Chart

    With Cht
        .HasLegend = True
        For Each Srs In .SeriesCollection
            Srs.Delete
        Next Srs
        
        Set Srs = .SeriesCollection.NewSeries
        With Srs
            .XValues = rngX
            .Values = rngY
        End With
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Cash (In Cr)"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Cash (In Cr)"
    End With
    
End Sub

Sub testChart()
    Dim Ws As Worksheet
    Dim rngDB As Range, Rng As Range
    Dim rngX As Range, rngY As Range
    Dim shp As Shape
    Dim Cht As Chart
    Dim Srs As Series
    Dim l As Single, t As Single
    Dim w As Single, h As Single
    Dim objChart As ChartObject
  
    Set Ws = Sheets("CashFlow")
    
    For Each objChart In Ws.ChartObjects
        objChart.Delete
    Next objChart
    
    Set rngDB = Ws.Range("a3: a12")
    
    l = 1 'left
    t = Ws.Range("a14").Top 'top
    w = 400 'width
    h = 200      'height

    Set shp = Ws.Shapes.AddChart(xlLineMarkers, l, t, w, h)
    Set Cht = shp.Chart

    With Cht
        .HasLegend = True
        For Each Srs In .SeriesCollection
            Srs.Delete
        Next Srs
        
        For Each Rng In rngDB
            Set Srs = .SeriesCollection.NewSeries
            Set rngX = Ws.Range("b2").Resize(1, 5)
            Set rngY = Rng.Offset(0, 1).Resize(1, 5)
            With Srs
                .Name = Rng
                .XValues = rngX
                .Values = rngY
            End With
        Next Rng
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Cash (In Cr)"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Cash (In Cr)"
    End With
End Sub