Excel-VBA如何在图形上添加静态线?

时间:2019-01-03 00:11:19

标签: excel vba graph

我对这些东西还很陌生,所以很粗糙。我正在尝试创建一个脚本,该脚本绘制从测试中收集的值,然后绘制两个静态值(质量控制和生产的需求规格)进行比较。我已经能够创建一个显示测试值的图表,但是除非我像这样输入每个Array值,否则我似乎无法获得有关QC和Production规格的直线:

.Values = Array(19,19,19,19)

我希望线条的长度可以动态变化,以确保无论有多少行/列,它都可以在图形上延伸。

对于我应该朝哪个方向提供帮助或采取更好的方法,将非常感谢!

    Dim myChtObj As ChartObject
    Dim rngChtData As Range
    Dim rngChtXVal As Range
    Dim iColumn As Long
    Dim iRow As Long

    ' make sure a range is selected
    If TypeName(Selection) <> "Range" Then Exit Sub

    ' define chart data
    Set rngChtData = Selection

    ' define chart's X values
    With rngChtData
        Set rngChtXVal = .Columns(1).Offset(1).Resize(.Rows.Count - 1)
    End With

    ' add the chart
    Set myChtObj = ActiveSheet.ChartObjects.Add _
        (Left:=250, Width:=375, Top:=75, Height:=225)

    With myChtObj.Chart

        ' make an XY chart
        .ChartType = xlXYScatterLines

        ' remove extra series
        Do Until .SeriesCollection.Count = 0
            .SeriesCollection(1).Delete
        Loop

        ' add series from selected range, column by column
        For iColumn = 3 To rngChtData.Columns.Count
            With .SeriesCollection.NewSeries
                .Values = rngChtXVal.Offset(, iColumn - 1)
                .XValues = rngChtXVal
                .Name = rngChtData(1, iColumn)
            End With
        Next

      Set ser = .SeriesCollection.NewSeries
      ser.Values = Array(19, 19, 19, 19)
      ser.XValues = rngChtXVal
      ser.Name = "QC Retraction"

    End With
End Sub

电流输出

Current Output 我想输出什么

What I would like to Output

1 个答案:

答案 0 :(得分:2)

您只需要添加两个点的序列-一个点在最小的x轴值上,一个在最大值(具有相同的y值)。然后根据需要设置该行的格式。

例如:

  Set ser = .SeriesCollection.NewSeries
  .Legend.LegendEntries(.SeriesCollection.Count).Delete 'remove from legend
  With ser
    .Values = Array(19, 19)
    .XValues = Array(myChtObj.Chart.Axes(xlCategory).MinimumScale, _
                     myChtObj.Chart.Axes(xlCategory).MaximumScale)
    .Name = ""
    .MarkerStyle = -4142  'no markers
    .Format.Line.ForeColor.RGB = vbBlack
    .Points(2).ApplyDataLabels
    .Points(2).DataLabel.Format.TextFrame2.TextRange.Characters.Text = "QC Retraction"
  End With

编辑-添加直线本身可能会更改x轴限制,因此您可能要在添加序列之前直接设置这些限制。