Как добавить метки данных на гистограмму и добавить значение из ячеек с помощью VBA

Question

Желание добавлять метки и извлекать значения из ячейки во все столбцы графика динамически, но решение, приведенное ниже, фиксируется на определенном количестве столбцов и строк.Нуждается в динамическом способе сделать это

Я использовал макро-рекордер, и появляется следующая функция.Тем не менее, это позволяет мне только добавлять зависимо для каждой данной серии.

    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.FullSeriesCollection(1).Select
    ActiveChart.FullSeriesCollection(1).ApplyDataLabels

Аналогично для значений из функции ячеек, которая вызывается из листа с именем ABC, где начиная со строки 2 соответствуют 1-й серии наgraph.

    ActiveChart.FullSeriesCollection(1).DataLabels.Select
    ActiveChart.FullSeriesCollection(1).DataLabels.Select
    ActiveChart.SeriesCollection(1).DataLabels.Format.TextFrame2.TextRange. _
        InsertChartField msoChartFieldRange, "=ABCs!$2:$2", 0
    Selection.ShowRange = True
    Selection.ShowValue = False

В идеале мне нужен код, который может динамически добавлять метки и значения из ячеек в зависимости от количества столбцов на графике и строк на листе ABC.Спасибо!

Answer 1

Может изменить код теста по вашему требованию.После добавления меток данных, получите диапазон определенной серии, манипулируя FormulaLocal серии.Затем выполните цикл по всем ячейкам в диапазоне (или каждой точке в ряду и установите Datalabel.Text со смещения по вашему желанию.

Sub test()
Dim Cht As Chart, Srs As Series, Pnt As Long
Dim Rng As Range, cel As Range, Xstr As String

Set Cht = ActiveSheet.ChartObjects("Chart 1").Chart
Set Srs = Cht.SeriesCollection(1)
Xstr = Srs.FormulaLocal
Set Rng = Range(Split(Xstr, ",")(2))

    Pnt = 1
    For Each cell In Rng.Cells
    Srs.Points(Pnt).DataLabel.Text = cell.Offset(2, 0).Value ' Set offset according to your desired Row / Column from seriescollection range
    Pnt = Pnt + 1
    Next
End Sub

Изображение результата

сЯ тестировал код в Excel 2007, возможно, потребуется заменить SeriesCollection на FullSeriesCollection. Пожалуйста, попробуйте отправить отзыв.