Question

我的工作簿中有几张包含要绘制的数据的工作表，每次运行新分析时都会生成一个新工作表。

在我的第一张纸上，我将所有数据绘制在同一图表中，因此为了避免每次添加新纸张时重新绘制所有系列，我只想添加一个新系列。

我认为这应该很简单，但不是出于两个原因：当我第一次创建图表时，它会自动添加1到9个系列：

 Set myChart = ws.Shapes.AddChart.Chart
 myChart.ChartType = xlXYScatterLinesNoMarkers

为什么会生成任何随机序列？

如果我删除图形，因为我想重新运行一个分析，那么图形将被调用2，依此类推......所以我试着给它起一个名字，然后引用它的名字，但是这不起作用：

Set myChart = ws.ChartObjects(ws.Name)

因此，在第一张工作表（原始）中，我绘制了工作簿中的所有数据，其余的我只绘制了当前工作表的数据，如下所示。我在两种情况下使用相同的代码函数，其中我只将参数all传递为true（原始工作表）或false（工作表1 ..... 300）

以下是代码：

Sub createChart(ws As Worksheet, Optional all As Boolean = False)
Dim lastRow As Long
Dim myChart As Chart
Dim temp As Integer
Dim n As Integer


On Error Resume Next
' Delete the charts, just in case
If ws.ChartObjects.Count > 0 Then ' And Not all Then
    ws.ChartObjects.Delete
End If

'If ws.ChartObjects.Count = 0 Then
    Set myChart = ws.Shapes.AddChart.Chart
    myChart.Name = ws.Name
'Else
    'Set myChart = ws.ChartObjects(ws.Name) '''Fails why commented out
'End If



myChart.ChartType = xlXYScatterLinesNoMarkers
myChart.SetElement (msoElementPrimaryCategoryGridLinesMinor)
myChart.SetElement (msoElementPrimaryValueGridLinesMinorMajor)
myChart.SetElement (msoElementLegendBottom)
myChart.SetElement (msoElementChartTitleCenteredOverlay)

myChart.Parent.width = 800  ' px width graph
myChart.Parent.height = 500 ' px height graph

' it adds mysterious sometimes several random series, so we need to delete those that does not match sheet name
For n = myChart.SeriesCollection.Count To 0 Step -1
    If Not SheetExists(myChart.SeriesCollection(n).Name) Then
        myChart.SeriesCollection(n).Delete
    End If
Next n


'*******************************************************************
'**************** FIRST PAGE CHART *********************************
'*******************************************************************
If all Then
    Dim wsOther As Worksheet
    Dim i As Integer
    Dim fixRange As Boolean
    Dim skipGraph As Boolean

    fixRange = True

    myChart.HasLegend = True
    myChart.Legend.Position = xlLegendPositionRight
    myChart.Parent.Top = 120
    myChart.Parent.Left = 450


    For Each wsOther In ThisWorkbook.Worksheets
        If wsOther.Name <> ws.Name Then
            lastRow = getLastRow(wsOther, 1)
            skipGraph = False
            '******* we only add graphs if it is not before ******************
            If myChart.SeriesCollection.Count > 0 Then
                For n = myChart.SeriesCollection.Count To 1 Step -1
                    If myChart.SeriesCollection(n).Name = wsOther.Name Then
                        skipGraph = True
                        Exit For
                    End If
                Next n
            End If

            If Not skipGraph Then
                With myChart.SeriesCollection.NewSeries
                    .Values = "=" & wsOther.Name & "!$E$2:$E$" & lastRow
                    .Name = wsOther.Name
                    .XValues = "=" & wsOther.Name & "!$B$2:$B$" & lastRow
                End With
           End If
            If fixRange Then
                ' Range on axis
                myChart.Axes(xlPrimary).MinimumScale = CDate(Application.WorksheetFunction.Min(Range(wsOther.Name & "!$B$2:$B$" & lastRow).Value2))
                myChart.Axes(xlPrimary).MaximumScale = CDate(Application.WorksheetFunction.Max(Range(wsOther.Name & "!$B$2:$B$" & lastRow).Value2))

                myChart.Axes(xlValue, xlPrimary).ScaleType = xlLogarithmic
                fixRange = False
            End If

        End If
    Next


'*******************************************************************************************************
'****************** SINGLE CHART ***********************************************************************
'*******************************************************************************************************
Else
    myChart.HasLegend = False
    myChart.Parent.Top = 40
    myChart.Parent.Left = 300


    lastRow = getLastRow(ws, 1)

    With myChart.SeriesCollection.NewSeries
        .Values = "=" & ws.Name & "!$E$2:$E$" & lastRow
        .XValues = "=" & ws.Name & "!$B$2:$B$" & lastRow
    End With

    ' Range on axis
    myChart.Axes(xlPrimary).MinimumScale = CDate(Application.WorksheetFunction.Min(Range(ws.Name & "!$B$2:$B$" & lastRow).Value2))
    myChart.Axes(xlPrimary).MaximumScale = CDate(Application.WorksheetFunction.Max(Range(ws.Name & "!$B$2:$B$" & lastRow).Value2))
End If

' *********************************************************************
' ******************* Sizing ******************************************
' *********************************************************************

With myChart.PlotArea
    temp = .Top
    temp = .height
    .Top = 70
    .height = 420
End With

'really dirty and crappy formatting of title
myChart.ChartTitle.Text = "Faraday Torr"

'X axis name
myChart.Axes(xlCategory, xlPrimary).HasTitle = True
myChart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Time [s]"


'y-axis name
myChart.Axes(xlValue, xlPrimary).HasTitle = True
myChart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Pressure[Torr]"




Set myChart = Nothing
Set wsOther = Nothing

ws.Select
ws.Range("A1").Select



End Sub

vba仅在图表不存在时添加新系列

0 个答案: