Question

想要动态添加标签并从单元格中检索值到图形上的所有条形图，但是下面的解决方案固定在特定数量的条形图和行上。需要一种动态的方式来实现

我使用了宏记录器，出现以下功能。但是，这仅允许我将相关项添加到给定的每个系列中。

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

同样，对于名为ABC的工作表中调用的cells函数的值，其中从第2行开始对应于图形中的第一个序列。

    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

Result image

由于我在Excel 2007中测试了代码，可能需要将SeriesCollection替换为FullSeriesCollection。请尝试并提供反馈。

如何在条形图上添加数据标签并使用VBA从单元格中添加价值

1 个答案: