如何在Excel VBA中创建自动化动态线图 [英] How to create an automated dynamic line graph in Excel VBA

问题描述

我有一个工作问题。我有一个数据报告，其中有大量的信息，我需要创建3个线形图表示3个不同的值随着时间的推移。时间也在报告中，是所有价值观的同一时间。我在其他地方的论坛找到一个解决我的解决方案的麻烦。

数据报告的长度，行数有所不同。我需要做的是创建3条线图，并将它们水平定位，在报告结尾处的几行。其中两个图有一个系列，第三个有两个系列。

图表需要包括：

图1：随时间变化的RPM

图2：压力随着时间的推移

图3：逐步烧毁和需求随着时间的推移

我刚刚进入VBA，因为最近在工作上发生了一个变化，我知道的很少，但是我花了很多时间弄清楚如何为同一报告编写其他宏。由于我的工作簿的口头陈述不清楚，我附上了一个链接，以查看数据报告的样本。

数据报告工作簿下载

这是我到目前为止。它适用于第一张图表。现在我可以用代码来命名图表RPM并命名系列RPM？

 子测试（）
 Dim LastRow As Long 
 Dim Rng1 As Range 
 Dim ShName As String 
 With ActiveSheet 
 LastRow = .Range（B& .Rows.Count ）.End（xlUp）.Row 
设置Rng1 = .Range（B2：B& LastRow&，E2：E& LastRow）
 ShName = .Name 
 
结束
 Charts.Add 
与ActiveChart 
 .ChartType = xlLine 
 .SetSourceData来源：= Rng1 
。位置其中：= xlLocationAsObject，名称： = ShName 
结束
结束Sub 
  

我已经弄清楚如何放通过VBA的图表名称。代码现在看起来像这样：

  Sub Test（）
 Dim LastRow As Long 
 Dim Rng1 As范围
 Dim ShName As String 
 With ActiveSheet 
 LastRow = .Range（B& .Rows.Count）.End（xlUp）.Row 
设置Rng1 = .Range （B2：B& LastRow&，E2：E& LastRow）
 ShName = .Name 
结束
 
 Charts.Add 
使用ActiveChart 
 .ChartType = xlLine 
 .HasTitle = True 
 .ChartTitle.Text =RPM
 .SetSourceData Source：= Rng1 
。位置其中：= xlLocationAsObject ，名称：= ShName 
结束
 
结束子
  

接下来我将在系列标题上进行工作，然后将图表的位置自己放在报表数据下。欢迎提出建议和意见。

下面更新的代码分别创建了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 
设置Rng1 = .Range（B2：B& LastRow &，E2：E& LastRow）
 ShName = .Name 
结束
 
 Charts.Add 
与ActiveChart 
 .ChartType = xlLine 
 .HasTitle = True 
 .ChartTitle.Text =RPM
 .SetSourceData Source：= Rng1 
 .Location其中：= xlLocationAsObject，Name：= ShName 
结束
 
与ActiveChart.SeriesCollection（1）
 .Name =RPM
结束
 
'压力图------ -------------------------- 
 
 Dim LastRow2 As Long 
 Dim Rng2 As Range 
 Dim ShName2 As String 
 With ActiveSheet 
 LastRow2 = .Range（B&am p。.Rows.Count）.End（xlUp）.Row 
设置Rng2 = .Range（B2：B& LastRow2& ，G2：G& LastRow2）
 ShName2 = .Name 
结束
 
 Charts.Add 
与ActiveChart 
 .ChartType = xlLine 
 .HasTitle = True 
 .ChartTitle.Text =Pressure / psi
 .SetSourceData Source：= Rng2 
 .Location其中：= xlLocationAsObject，Name：= ShName2 
 End with 
 
 With ActiveChart.SeriesCollection（1）
 .Name =Pressure
 End with 
 End Sub 
  

$大卫，我好奇地看到你的代码如何与我的工作表一起使用，但我不知道如何修复语法错误。

解决方案

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

 使用ActiveChart.SeriesCollection（1）
 .Name =RPM
'##您可以进一步操作一些系列属性，如：'
'.XValues = range_variable'##可以分配一系列的分类
'.Values = another_range_variable'##你可以在这里指定一个值范围'
结束
  

现在，您将代码添加到表格中的图表。但是一旦创建了它们，可能你不想重新添加新的图表，你只需要更新现有的图表。

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

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

REVISED

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 
设置xValRange = .Range（B2：B& LastRow）
 shtName = .Name& 
结束
 
 
'##设置每个图表中系列1的值##'
对于每个cObj在ActiveSheet.ChartObjects 
设置cht = cObj.Chart 
 chtName = shtName& cht.Name 
 
如果cht.SeriesCollection.Count = 0然后
'##添加一个虚拟系列，将在下面的代码中替换##'
使用cht.SeriesCollection .NewSeries 
 .Values ={1,2,3}
 .XValues = xValRange 
结束
 
结束如果
 
 '##假设每个图表只有一个系列，我们只是重新设置值&每个图表的每个角度##'
带有cht.SeriesCollection（1）
'##分配类别/ XValues ##'
 .XValues = xValRange 
 
'＃ ＃这里，我们根据图表名称设置要用于值的范围：##'
选择案例替换（chtName，shtName，vbNullString）
案例RPM
 .Values = xValRange.Offset（0,3）'##列E是列B中的xValRange的3个偏移
案例压力/ psi
 .Values = xValRange.Offset（0，5）'##列G与列B中的xValRange的偏移量为5 
案例第三图
 .Values = xValRange.Offset（0,6）'##列H与列B中的xValRange 6偏移b 
 $ b'##确保这个图表有2个系列，如果没有，添加一个虚拟系列##'
如果cht.SeriesCollection.Count< 2然后
与cht.SeriesCollection.NewSeries 
 .XValues ={1,2,3}
结束
结束如果
'##添加数据对于第二个系列：##'
 cht.SeriesCollection（2）.XValues = xValRange 
 cht.SeriesCollection（2）.Values = xValRange.Offset（0,8）'## Column J是8 offset从列B中的xValRange 
 
案例根据需要添加这些案例中的数量
 
结束选择
 
结束
 
 Next 
 End Sub 
  

REVISION＃3 要允许创建图表（如果工作表中不存在），请将这些行添加到 DeleteRows_0_Step（）子例程的底部：

运行CreateCharts

运行UpdateCharts / code>

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

  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 
 
设置ws = ActiveSheet 
 lastRow = ws.Range（A1，Range（A2）。End（xlDown））。Rows.Count 
 
c = 1 
'##在此工作表中创建一个图表名称数组。 ##'
对于每个cObj在ActiveSheet.Shapes 
如果cObj.HasChart然后
 ReDim保存chts（c）
 chts（c）= cObj.Name 
 
c = c + 1 
结束如果
下一个
 
'##检查您的图表是否存在于工作表上##'
如果c = 1然后
 ReDim保存chts（0）
 chts（0）=
结束If 
如果IsError（Application.Match（RPM，chts，False））然后
'##添加此图表##'
 chtLeft = ws.Cells（lastRow，1）.Left 
 chtTop = ws.Cells（lastRow，1）.Top + ws.Cells（ lastRow，1）.Height 
设置cObj = ws.Shapes.AddChart（xlLine，chtLeft，chtTop，355,211）
 cObj.Name =RPM
 cObj.Chart.HasTitle = True 
设置cht = cObj.Chart 
 cht.ChartTitle.Characters.Text =RPM
 clearChart 
如果
 
 
如果IsError（Application.Match（Pressure / psi，chts，False））然后
'##添加此图表##'
使用ws.ChartObjects（RPM） 
 chtLeft = .Left + .Width + 10 
 chtTop = .Top 
设置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 
 
 
如果IsError（Application.Match（Third Chart，chts，False））然后
'##添加此图表##'
带有ws.ChartObjects（Pressure / psi）
 chtLeft = .Left + .Width + 10 
 chtTop = .Top 
设置cObj = ws .Shapes.AddChart（xlLine，chtLeft，chtTop，355,211）
 cObj.Name =第三图
 cObj.Chart.HasTitle = True 
设置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 
对于每个srs在cht.SeriesCollection 
如果不是cht.SeriesCollection.Count = 1然后srs.Delete 
下一个
 End Sub 
  

I have a work problem. I have a data report with tons of information in it and I need to create 3 line graphs to represent 3 different values over time. The time is also in the report and is the same time for all of the values. I am having trouble finding a solution specific to me in forums elsewhere.

The data report varies in length, rows. What I need to do is to create the 3 line graphs and have them positioned horizontally, a few rows under the end of the report. Two of the graphs have one series each and the third has two series.

This is what the graphs need to include:

Graph 1: RPM over Time
Graph 2: Pressure over Time
Graph 3: Step burn off and Demand burn off over Time

I am just getting into VBA because of a recent position change at work and I know very little about it but I have spent a lot of time figuring out how to write other macros for the same report. Since my verbal representation of the workbook is unclear I have attached a link to a sample of the data report for viewing.

Data Report Workbook Download

Here is what I have so far. It works for the first chart. Now what can I put in the code to name the chart "RPM" and to name the series "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

I have figured out how to put the chart name in via VBA. The code now looks like this:

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

I will next be working on the series title and then on to having the chart place itself under the report data. Suggestions and comments welcome.

The updated code below creates the rpm chart and the pressure chart separately. The last chart needs two series and I am working on that now.

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, I am curious to see how your code works with my worksheet but I'm not sure how to fix the syntax error.

解决方案

To manipulate the Series title (you only have one series in each of these charts) you could do simply:

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

Now, what code you have is adding charts to the sheet. But once they have been created, presumably you don't want to re-add a new chart, you just want to update the existing chart.

Assuming you only will have one series in each of these charts, you could do something like this to update the charts.

How it works is by iterating over each chart in the worksheet's chartobjects collection, and then determining what Range to use for the Series Values, based on the chart's title.

REVISED to account for the third chart which has 2 series.

REVISED #2 To add series to chart if chart does not have series data.

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 To allow for creation of charts if they do not already exist in the worksheet, add these lines to the bottom of your DeleteRows_0_Step() subroutine:

Run "CreateCharts"

Run "UpdateCharts"

Then, add these subroutines to the same code module:

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

这篇关于如何在Excel VBA中创建自动化动态线图的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！