如何在Excel VBA中创build自动dynamic线图

我有一个工作问题。 我有一个包含大量信息的数据报告，我需要创build3个线图来表示随着时间的推移3个不同的值。 时间也在报告中，对所有的价值来说都是同一时间。 我无法在别处的论坛中find特定于我的解决scheme。

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

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

图1：随时间变化的RPM
图2：随时间推移的压力
图3：步骤烧掉，需求随时间消耗

我刚刚进入VBA是因为最近在工作中发生了位置变化，我对此知之甚less，但是我花了很多时间来弄清楚如何为同一报告编写其他macros。 由于我的工作手册的口头expression不清楚，我附上了一份数据报告样本的链接。

数据报告工作簿下载

这是我到目前为止。 它适用于第一个图表。 现在我可以在代码中放入什么命名图表“RPM”并命名系列“RPM”？

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 .SetSourceData Source:=Rng1 .Location Where:=xlLocationAsObject, Name:=ShName End With End Sub 

我已经想通过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 

接下来，我将在系列标题上进行研究，然后将图表置于报告数据之下。 build议和意见欢迎。

下面更新的代码分别创build了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 

大卫，我很好奇，看看你的代码如何与我的工作表，但我不知道如何解决语法错误。

Answer 1

要操纵系列标题（每个图表中只有一个系列），您可以简单地执行以下操作：

 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 

现在，你有什么代码是添加图表到工作表。 但是一旦创build完成，大概你不想重新添加一个新的图表，只想更新现有的图表。

假设你在这些图表中只有一个系列，你可以这样做来更新图表。

它的工作原理是迭代工作表的chartobjects集合中的每个图表，然后根据图表的标题确定用于Series Values的范围。

修改为占有 2个系列的第三个图表。

REVISED＃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 

REVISION＃3为了允许创build图表（如果它们不在工作表中），请将这些行添加到DeleteRows_0_Step()子例程的底部：

Run "CreateCharts"

Run "UpdateCharts"

然后，将这些子例程添加到相同的代码模块：

 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