一张纸上的多个图表对象

时间:2016-01-25 15:27:51

标签: excel excel-vba charts vba

我正在尝试在一张纸上放置两个图表对象,并且在使用Excel 2010时遇到了困难。

我的代码在单个图表对象下工作正常,但是当我添加了一个额外的图表时:图表类型,标题和其他属性没有在第二个图表上注册。

两个图表应具有相同的结构,但在工作表上引用不同的列。我环顾四周但找不到解决方案。请建议如何解决此问题。我只发布部分代码,但如果它有用,可以发布其余的代码。对不起,如果代码太长了......

我非常感谢你的帮助。

Function GraphMFI(Arr() As Variant, Arr2() As Variant, ChartName As String, ChartName2 As String)

Dim i As Long, l As Long
Dim rng As Range, aCell As Range
Dim MyArY() As Variant, MyArX() As Variant
Dim LastRow As Long, iVal As Long
Dim Count As Long, SumArr As Long, AvgC As Long

Application.EnableEvents = False

'***********************************************************************
'Code that calculates x and y values not shown
'**************************************************************************
On Error Resume Next

'~~~~~~~~~chart code begins

Call DeleteallCharts 'delete all existing charts from active sheet
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~add both charts~~~~~~
Set objChart = ActiveSheet.ChartObjects.Add _
(Left:=410, Width:=500, Top:=15, Height:=250)
objChart.Chart.ChartType = xlXYScatterLines

Set objChart2 = ActiveSheet.ChartObjects.Add _
(Left:=410, Width:=500, Top:=300, Height:=250)
objChart.Chart.ChartType = xlXYScatterLines
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~add both charts~~~~~~

Dim objChartSeriesColl As SeriesCollection
Dim objChartSeriesColl2 As SeriesCollection

Set objChartSeriesColl = objChart.Chart.SeriesCollection
Set objChartSeriesColl2 = objChart2.Chart.SeriesCollection
'delete all chart series

'~~~~~~~~~~~first chart
With objChartSeriesColl.NewSeries '~~~raw data

.Name = "Inner Run Variability"
.Values = Arr
.XValues = rng
.MarkerSize = 10
.
    'code not shown
End With

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~First Chart
With objChartSeriesColl.NewSeries '~~~average series one
Dim nPts As Long
.Name = "Mean"
.Values = AvgArr '~~~~average of Negative control
.XValues = rng '~~~dates
'.AxisGroup = xlSecondary
.ChartType = xlXYScatterLinesNoMarkers

 'With mySrs
        nPts = .Points.Count
        .Points(nPts).ApplyDataLabels _
            Type:=xlDataLabelsShowValue, _
            AutoText:=True, LegendKey:=False
        .Points(nPts).DataLabel.Text = .Name
        .Points(nPts).ApplyDataLabels Type:=xlDataLabelsShowValue, _
                    AutoText:=True, LegendKey:=False
With .DataLabels
            .AutoScaleFont = False
            .Font.Size = 10
            .Font.ColorIndex = 3
            .Position = xlLabelPositionAbove
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlCenter
            .Orientation = xlHorizontal
        End With
    '~~~~~~~~~~~~~~~~~~

End With

With objChartSeriesColl.NewSeries '~~plus two stdev series two
.Name = "plus 2 stdev"
.Values = TwoPlusSdtDevArr
.XValues = rng '~~~dates
End With

With objChartSeriesColl.NewSeries 'minus three stdev series three
.Name = "minus 2 stdev"
.Values = TwiceStdDevArr
.XValues = rng
.ChartType = xlXYScatterLinesNoMarkers
End With

'~~~~~~~~~~~Second chart
With objChartSeriesColl2.NewSeries '~~~raw data
.Name = "Inner Run Variability"
.Values = Arr2
.XValues = rng
.MarkerSize = 10
End With

'~~~~~adding series to the second chart

With objChartSeriesColl2.NewSeries '~~~average
Dim nPts2 As Long
.Name = "Mean"
.Values = AvgArr
.XValues = rng '~~~dates
.ChartType = xlXYScatterLinesNoMarkers

End With

'....more series not shown here

With objChart

            .Axes(xlCategory).TickLabels.NumberFormat = "m/d/yyyy" 'changes Xaxis text format
            .Axes(xlValue).TickLabels.NumberFormat = "General" 'changes Yaxis Text Format
            .SetElement (msoElementChartTitleAboveChart) 'adds chart title above chart
            .SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis) 'adds Xaxis title
            .SetElement (msoElementPrimaryValueAxisTitleRotated) 'adds rotated Yaxis Title

            .ChartTitle.Text = ChartName  'adds chart title above chart
            .SetElement (msoElementLegendNone)

            '~~~~~~~~~~~~set plot area
            With .PlotArea
                    .Width = .Width / 2
                    .Height = .Height / 2
                    .Left = 16
                    .Top = 16
                    .Width = 450
                End With
'~~~~~~~~~~~~~~~~
            With .Axes(xlCategory, xlPrimary)
                .AxisTitle.Text = "Run Dates" 'renames Xaxis title to "X Title"
                .AxisTitle.Font.Bold = True
          End With
            With .Axes(xlValue, xlPrimary)
                .AxisTitle.Text = "Sample Dates" 'renames Xaxis title to "X Title"
                .AxisTitle.Text = "MFI Values" 'renames Yaxis title to "Y Title"
            End With
            .Axes(xlCategory).MinimumScale = ChartMin '~~adds min

            .Axes(xlCategory).MaximumScale = ChartMax '~~ adds max
            .Parent.Placement = xlFreeFloating

            With .ChartArea.Format.Line
                .Visible = msoCTrue
                .Style = msoLineSingle
                .Weight = 1
                .ForeColor.RGB = RGB(255, 255, 255)

            End With

        End With
        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        'more code
End With

''''~~~~~~~~~~~~~Second Chart begins here

With objChart2
'..........
'code almost the same as 'with objChart'

  Application.EnableEvents = True
End With
End Function

0 个答案:

没有答案