如何在excelvba中创建自动动态线图

我工作有问题。我有一个包含大量信息的数据报告，我需要创建3个折线图来表示3个不同的值。时间也在报告中，并且对于所有值都是相同的时间。我在其他论坛上很难找到适合我的解决方案

数据报告的长度、行数不同。我需要做的是创建3个折线图，并将它们水平放置在报告末尾的几行下面。其中两个图各有一个系列，第三个图有两个系列

这是图表需要包括的内容：

图1：随时间变化的转速
图2：随时间变化的压力
图3：随着时间的推移，逐步消耗和需求消耗

我刚进入VBA是因为最近工作中的一次职位变动，对此我知之甚少，但我花了很多时间研究如何为同一份报告编写其他宏。由于我对工作簿的口头表述不清楚，因此我附上了数据报告样本的链接，以供查看

这是我到目前为止所拥有的。它适用于第一个图表。现在我可以在代码中输入什么来命名图表“RPM”和系列“RPM”

我已经学会了如何通过VBA输入图表名称。代码现在如下所示：

Sub Test()
    Dim LastRow As Long
    Dim Rng1 As Range
    Dim ShName As String
    With ActiveSheet
        LastRow = .Range("B" & .Rows.Count).End(xlUp).Row
        Set Rng1 = .Range("B2:B" & LastRow & ", E2:E" & LastRow)
        ShName = .Name
    End With

    Charts.Add
    With ActiveChart
        .ChartType = xlLine
        .HasTitle = True
        .ChartTitle.Text = "RPM"
        .SetSourceData Source:=Rng1
        .Location Where:=xlLocationAsObject, Name:=ShName
    End With

End Sub

接下来，我将研究这个系列的标题，然后将图表放在报表数据下。欢迎提出建议和意见

下面更新的代码分别创建rpm图表和压力图表。最后一张图表需要两个系列，我现在正在努力

Sub chts()

'RPM chart-------------------------------------
    Dim LastRow As Long
    Dim Rng1 As Range
    Dim ShName As String
    With ActiveSheet
        LastRow = .Range("B" & .Rows.Count).End(xlUp).Row
        Set Rng1 = .Range("B2:B" & LastRow & ", E2:E" & LastRow)
        ShName = .Name
    End With

    Charts.Add
    With ActiveChart
        .ChartType = xlLine
        .HasTitle = True
        .ChartTitle.Text = "RPM"
        .SetSourceData Source:=Rng1
        .Location Where:=xlLocationAsObject, Name:=ShName
    End With

    With ActiveChart.SeriesCollection(1)
        .Name = "RPM"
    End With

' Pressure chart --------------------------------

    Dim LastRow2 As Long
    Dim Rng2 As Range
    Dim ShName2 As String
    With ActiveSheet
        LastRow2 = .Range("B" & .Rows.Count).End(xlUp).Row
        Set Rng2 = .Range("B2:B" & LastRow2 & ", G2:G" & LastRow2)
        ShName2 = .Name
    End With

    Charts.Add
    With ActiveChart
        .ChartType = xlLine
        .HasTitle = True
        .ChartTitle.Text = "Pressure/psi"
        .SetSourceData Source:=Rng2
        .Location Where:=xlLocationAsObject, Name:=ShName2
    End With

    With ActiveChart.SeriesCollection(1)
        .Name = "Pressure"
    End With
End Sub

---

David，我很想看看您的代码如何与我的工作表配合使用，但我不确定如何修复语法错误。

要处理系列标题（每个图表中只有一个系列），您只需执行以下操作：

With ActiveChart.SeriesCollection(1)
    .Name = "RPM"
    '## You can further manipulate some series properties, like: '
    '.XValues = range_variable  '## you can assign a range of categorylabels here'
    '.Values = another_range_variable '## you can assign a range of Values here'
End With

现在，您拥有的代码是将图表添加到工作表中。但是一旦它们被创建，您可能不想重新添加一个新的图表，您只想更新现有的图表

假设每个图表中只有一个系列，您可以执行类似的操作来更新图表

它的工作原理是迭代工作表的chartobjects集合中的每个图表，然后根据图表的标题确定系列值的范围

修订了以说明第三张图表，该图表有两个系列

修订#2以在图表没有序列数据时将序列添加到图表中

Sub UpdateCharts()
Dim cObj As ChartObject
Dim cht As Chart
Dim shtName As String
Dim chtName As String
Dim xValRange As Range
Dim LastRow As Long

With ActiveSheet
    LastRow = .Range("B" & .Rows.Count).End(xlUp).Row
    Set xValRange = .Range("B2:B" & LastRow)
    shtName = .Name & " "
End With


'## This sets values for Series 1 in each chart ##'
For Each cObj In ActiveSheet.ChartObjects
    Set cht = cObj.Chart
    chtName = shtName & cht.Name

    If cht.SeriesCollection.Count = 0 Then
    '## Add a dummy series which will be replaced in the code below ##'
        With cht.SeriesCollection.NewSeries
            .Values = "{1,2,3}"
            .XValues = xValRange
        End With

    End If

    '## Assuming only one series per chart, we just reset the Values & XValues per chart ##'
    With cht.SeriesCollection(1)
    '## Assign the category/XValues ##'
       .XValues = xValRange

    '## Here, we set the range to use for Values, based on the chart name: ##'
        Select Case Replace(chtName, shtName, vbNullString)
             Case "RPM"
                  .Values = xValRange.Offset(0, 3) '## Column E is 3 offset from the xValRange in column B
             Case "Pressure/psi"
                  .Values = xValRange.Offset(0, 5) '## Column G is 5 offset from the xValRange in column B
             Case "Third Chart"
                .Values = xValRange.Offset(0, 6)   '## Column H is 6 offset from the xValRange in column B

                '## Make sure this chart has 2 series, if not, add a dummy series ##'
                If cht.SeriesCollection.Count < 2 Then
                    With cht.SeriesCollection.NewSeries
                        .XValues = "{1,2,3}"
                    End With
                End If
                '## add the data for second series: ##'
                cht.SeriesCollection(2).XValues = xValRange
                cht.SeriesCollection(2).Values = xValRange.Offset(0, 8)  '## Column J is 8 offset from the xValRange in column B

             Case "Add as many of these Cases as you need"

        End Select

    End With

Next
End Sub

---

还没有，我试着把我在其他网站和论坛上找到的片段拼凑起来，但我不断地出错，然后重新开始。这就是最终的结果。如果我能让流程自动化，那正是我所需要的。除了最后一张看起来破损的图表。我相信我以后可以解决这个问题。是的，我可以手动绘制它们并输入数据范围，但我想让它自动化，然后我会将宏分配给一个按钮，比如我已经放入的“修剪”按钮。点击按钮后，报告表应如上图所示。不要手动设置数据范围。您可以为此使用动态命名范围，或通过VBA（如果您选择该路线）。图表的定位是通过其包含的对象“上”和“左”来处理的，通过VBA可以轻松地进行操作。@K_B我刚才说我知道如何手动将图形组合在一起。我想让宏做的是获取信息，制作三个图表，并将它们放在所有数据的下方。我只是不知道如何为它编写代码。我努力拼凑“Trim”宏中使用的小代码。我复制了您的代码以查看它在工作表中的工作方式，但在“Set xValRange=”处不断出现语法错误。最后一张图表实际上有两个系列。我将继续浏览MSDN Office参考页。另外请注意，我正试图将所有三个图表编码放在一个模块中，因为我计划将这一个宏附加到一个按钮上，以方便单击。这只是为了缩短为客户创建报告的时间，并尽可能快地完成报告。我非常感谢迄今为止所有的帮助和输入。当您收到错误时，错误消息是什么，以及

lastRow

变量的值是什么？我不确定您的意思。我复制了你的代码。原谅我的无知。我应该进一步指定lastRow变量吗？到目前为止，我刚刚收到一条消息，即“Set xValRange=“Ooops！”的第二个实例中存在语法错误！我现在明白了。删除那一行--不确定它为什么在那里，但它不应该在那里！很抱歉我将修改：）

Sub UpdateCharts()
Dim cObj As ChartObject
Dim cht As Chart
Dim shtName As String
Dim chtName As String
Dim xValRange As Range
Dim LastRow As Long

With ActiveSheet
    LastRow = .Range("B" & .Rows.Count).End(xlUp).Row
    Set xValRange = .Range("B2:B" & LastRow)
    shtName = .Name & " "
End With


'## This sets values for Series 1 in each chart ##'
For Each cObj In ActiveSheet.ChartObjects
    Set cht = cObj.Chart
    chtName = shtName & cht.Name

    If cht.SeriesCollection.Count = 0 Then
    '## Add a dummy series which will be replaced in the code below ##'
        With cht.SeriesCollection.NewSeries
            .Values = "{1,2,3}"
            .XValues = xValRange
        End With

    End If

    '## Assuming only one series per chart, we just reset the Values & XValues per chart ##'
    With cht.SeriesCollection(1)
    '## Assign the category/XValues ##'
       .XValues = xValRange

    '## Here, we set the range to use for Values, based on the chart name: ##'
        Select Case Replace(chtName, shtName, vbNullString)
             Case "RPM"
                  .Values = xValRange.Offset(0, 3) '## Column E is 3 offset from the xValRange in column B
             Case "Pressure/psi"
                  .Values = xValRange.Offset(0, 5) '## Column G is 5 offset from the xValRange in column B
             Case "Third Chart"
                .Values = xValRange.Offset(0, 6)   '## Column H is 6 offset from the xValRange in column B

                '## Make sure this chart has 2 series, if not, add a dummy series ##'
                If cht.SeriesCollection.Count < 2 Then
                    With cht.SeriesCollection.NewSeries
                        .XValues = "{1,2,3}"
                    End With
                End If
                '## add the data for second series: ##'
                cht.SeriesCollection(2).XValues = xValRange
                cht.SeriesCollection(2).Values = xValRange.Offset(0, 8)  '## Column J is 8 offset from the xValRange in column B

             Case "Add as many of these Cases as you need"

        End Select

    End With

Next
End Sub

Private Sub CreateCharts()

Dim chts() As Variant
Dim cObj As Shape
Dim cht As Chart
Dim chtLeft As Double, chtTop As Double, chtWidth As Double, chtHeight As Double
Dim lastRow As Long
Dim c As Long
Dim ws As Worksheet

Set ws = ActiveSheet
lastRow = ws.Range("A1", Range("A2").End(xlDown)).Rows.Count

c = -1
'## Create an array of chart names in this sheet. ##'
For Each cObj In ActiveSheet.Shapes
    If cObj.HasChart Then
        ReDim Preserve chts(c)
        chts(c) = cObj.Name

        c = c + 1
    End If
Next

'## Check to see if your charts exist on the worksheet ##'
If c = -1 Then
    ReDim Preserve chts(0)
    chts(0) = ""
End If
If IsError(Application.Match("RPM", chts, False)) Then
    '## Add this chart ##'
    chtLeft = ws.Cells(lastRow, 1).Left
    chtTop = ws.Cells(lastRow, 1).Top + ws.Cells(lastRow, 1).Height
    Set cObj = ws.Shapes.AddChart(xlLine, chtLeft, chtTop, 355, 211)
        cObj.Name = "RPM"
        cObj.Chart.HasTitle = True
        Set cht = cObj.Chart
        cht.ChartTitle.Characters.Text = "RPM"
        clearChart cht
End If


If IsError(Application.Match("Pressure/psi", chts, False)) Then
    '## Add this chart ##'
    With ws.ChartObjects("RPM")
        chtLeft = .Left + .Width + 10
        chtTop = .Top
        Set cObj = ws.Shapes.AddChart(xlLine, chtLeft, chtTop, 355, 211)
        cObj.Name = "Pressure/psi"
        cObj.Chart.HasTitle = True
        Set cht = cObj.Chart
        cht.ChartTitle.Characters.Text = "Pressure/psi"
        clearChart cht
    End With
End If


If IsError(Application.Match("Third Chart", chts, False)) Then
    '## Add this chart ##'
    With ws.ChartObjects("Pressure/psi")
        chtLeft = .Left + .Width + 10
        chtTop = .Top
        Set cObj = ws.Shapes.AddChart(xlLine, chtLeft, chtTop, 355, 211)
        cObj.Name = "Third Chart"
        cObj.Chart.HasTitle = True
        Set cht = cObj.Chart
        cht.ChartTitle.Characters.Text = "Third Chart"
        clearChart cht
    End With
End If


End Sub

Private Sub clearChart(cht As Chart)
Dim srs As Series
For Each srs In cht.SeriesCollection
    If Not cht.SeriesCollection.Count = 1 Then srs.Delete
Next
End Sub