Excel-VBA Как добавить статическую линию на график?

Question

Я довольно новичок в этом, так что это было грубо.Я пытаюсь создать сценарий, который отображает значения, собранные в результате тестирования, а затем 2 статических значения (требования спецификации для контроля качества и для производства) для сравнения.Мне удалось создать диаграмму, отображающую значения тестирования, но я не могу получить прямую линию для спецификаций контроля качества и производства, если не введу каждое значение массива следующим образом:

.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

Токовый выход

Что я хотел бы вывести

Answer 1

Вам нужно только добавить серию с двумя точками - одна с минимальным значением оси 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, поэтому вы можете установить их непосредственно перед добавлением ряда.