无法添加辅助轴

时间:2015-11-02 05:47:28

标签: excel vba excel-vba charts add

我试图使用下一个语句绘制大量数据。但是,我不知道为什么辅助轴没有被以下代码绘制:

    Sub IndividualPlots()

    Dim TF As Worksheet
    Dim OIL As Worksheet
    Dim WTR As Worksheet
    Dim TG As Worksheet
    Dim GL As Worksheet
    Dim RG As Worksheet
    Dim WC As Worksheet
    Dim MM As Worksheet
    Dim VRRStart As Worksheet

    Dim NewWs As Worksheet
    Dim cht As Chart
    Dim chtobj As ChartObject
    Dim Lastcol As Long
    Dim Currcol As Long

    Set TF = ThisWorkbook.Worksheets("TF")
    Set OIL = ThisWorkbook.Worksheets("OIL")
    Set WTR = ThisWorkbook.Worksheets("WTR")
    Set TG = ThisWorkbook.Worksheets("TG")
    Set GL = ThisWorkbook.Worksheets("GL")
    Set RG = ThisWorkbook.Worksheets("RG")
    Set WC = ThisWorkbook.Worksheets("RG")
    Set MM = ThisWorkbook.Worksheets("Master Monitor")
    Set VRRStart = ThisWorkbook.Worksheets("VRRStart")

    Application.ScreenUpdating = False


    ClrChts

    Lastcol = TF.Cells(5, Columns.Count).End(xlToLeft).Column

    For Currcol = 2 To Lastcol

        Set cht = ThisWorkbook.Charts.Add

                    'VRRstart Plot
                     With cht.SeriesCollection.NewSeries
                    .Name = "=" & VRRStart.Name & "!R1C2"
                    .Values = "=" & VRRStart.Name & "!R" & 7 & "C" & Currcol & ":R" & 8 & "C" & Currcol
                    .XValues = "=" & VRRStart.Name & "!R" & 7 & "C1:R" & 8 & "C1"
                      .Border.Color = RGB(0, 0, 0)
                      .Format.Line.Weight = 3
                    End With

                     'OIL Plot
                     With cht.SeriesCollection.NewSeries
                    .Name = "=" & OIL.Name & "!R1C2"
                    .Values = "=" & OIL.Name & "!R" & 6 & "C" & Currcol & ":R" & 96 & "C" & Currcol
                    .XValues = "=" & OIL.Name & "!R" & 6 & "C1:R" & 96 & "C1"
                      .Border.Color = RGB(153, 204, 0)
                    End With

                     'WTR Plot
                     With cht.SeriesCollection.NewSeries
                    .AxisGroup = 2
                    .Name = "=" & WTR.Name & "!R1C2"
                    .Values = "=" & WTR.Name & "!R" & 6 & "C" & Currcol & ":R" & 96 & "C" & Currcol
                    .XValues = "=" & WTR.Name & "!R" & 6 & "C1:R" & 96 & "C1"
                     .Border.Color = RGB(0, 0, 0)

                     End With


                      'TG Plot
                     With cht.SeriesCollection.NewSeries
                    .AxisGroup = 2
                    .Name = "=" & TG.Name & "!R1C2"
                    .Values = "=" & TG.Name & "!R" & 6 & "C" & Currcol & ":R" & 96 & "C" & Currcol
                    .XValues = "=" & TG.Name & "!R" & 6 & "C1:R" & 96 & "C1"
                     .Border.Color = RGB(255, 0, 0)
                     End With

                       'WC Plot
                     With cht.SeriesCollection.NewSeries
                    .Name = "=" & WC.Name & "!R1C2"
                    .Values = "=" & WC.Name & "!R" & 6 & "C" & Currcol & ":R" & 96 & "C" & Currcol
                    .XValues = "=" & WC.Name & "!R" & 6 & "C1:R" & 96 & "C1"
                     .Border.Color = RGB(255, 153, 0)
                     End With



                       With cht
                      .ChartType = xlXYScatterLines
                      .Axes(xlCategory).TickLabels.NumberFormat = "m/d/yy"
                      .HasTitle = True
                      .ChartTitle.Text = TF.Cells(4, Currcol)
                      .ChartTitle.Font.Size = 10
                      .HasLegend = True
                      .Legend.Position = xlLegendPositionBottom
                      .Location Where:=xlLocationAsObject, Name:=MM.Name

                      End With

                        '.Axes(xlCategory).MinimumScaleIsAuto = False
                    '.Axes(xlCategory).MinimumScale = 42248
                    '.Axes(xlCategory).MaximumScaleIsAuto = False
                    '.Axes(xlCategory).MaximumScale = 42338

                    '.Axes(xlValue).MinimumScaleIsAuto = False
                    '.Axes(xlValue).MinimumScale = 0
                    '.Axes(xlValue).MaximumScaleIsAuto = False
                    '.Axes(xlValue).MaximumScale = 860




            Next Currcol


Application.ScreenUpdating = True
End Sub

其他子:

Sub ClrChts()
Dim wks As Worksheet

For Each wks In Worksheets
    If wks.ChartObjects.Count > 0 Then
        wks.ChartObjects.Delete
    End If
Next wks
End Sub

使用图表或图表对象添加功能是一个问题吗?

0 个答案:

没有答案