Question

我正在尝试使用正确的 VBA 代码来创建图表并向图表的每一列添加额外的数据标签。我尝试为此录制一个宏，然后对其进行更改以满足我的需要。我没有收到任何错误消息。除了enter image description here添加额外的数据标签外，一切正常。

这是我得到的。

Sub Chart()
Dim ChRng As Range

LastRow = Cells(Rows.Count, "E").End(xlUp).Row

Range("E3").Select
Range(ActiveCell.Address, Cells(LastRow, ActiveCell.Column)).Select
Range(Selection, Selection.Offset(0, 2)).Select
Set ChRng = Selection
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=ChRng
    
ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Text = "Top Five Merchants of the Day"
ActiveChart.ChartTitle.Text = "Top Five Merchants of the Day"
Selection.Format.TextFrame2.TextRange.Characters.Text = _
    "Top Five Merchants of the Day"
With Selection.Format.TextFrame2.TextRange.Characters(1, 29).Font
    .BaselineOffset = 0
    .Bold = msoFalse
    .NameComplexScript = "+mn-cs"
    .NameFarEast = "+mn-ea"
    .Fill.Visible = msoTrue
    .Fill.ForeColor.RGB = RGB(89, 89, 89)
    .Fill.Transparency = 0
    .Fill.Solid
    .Size = 14
    .Italic = msoFalse
    .Kerning = 12
    .Name = "+mn-lt"
    .UnderlineStyle = msoNoUnderline
    .Spacing = 0
    .Strike = msoNoStrike
End With

For Each cht In ActiveSheet.ChartObjects
cht.Name = "Chart 11"
Next cht

ActiveChart.ChartArea.Select
ActiveSheet.Shapes("Chart 11").ScaleWidth 1.45, msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes("Chart 11").ScaleHeight 1.28125, msoFalse, _
    msoScaleFromTopLeft
ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Left = ActiveChart.ChartArea.Width
ActiveChart.ChartTitle.Left = ActiveChart.ChartTitle.Left / 2
ActiveChart.FullSeriesCollection(1).Select
ActiveChart.FullSeriesCollection(1).ApplyDataLabels
ActiveChart.FullSeriesCollection(1).DataLabels.Select
Selection.Separator = "" & Chr(13) & ""
Application.CutCopyMode = False
ActiveChart.FullSeriesCollection(1).DataLabels.Select

ActiveChart.SeriesCollection(1).DataLabels.Format.TextFrame2.TextRange. _
    InsertChartField msoChartFieldRange, Sheets("Pivot").Range("H4").End(xlDown), 0
Selection.ShowRange = True

End Sub

相反，如果我使用下面的代码，它会添加额外的数据标签。由于我的数据每次都会发生变化，我希望能够灵活地选择数据标签。

有人可以帮我吗？我需要得到一张像图片链接中的图表。

ActiveChart.FullSeriesCollection(1).DataLabels.Select
ActiveChart.SeriesCollection(1).DataLabels.Format.TextFrame2.TextRange. _
    InsertChartField msoChartFieldRange, "=Pivot!$H$4:$H$8", 0
Selection.ShowRange = True

Answer 1

我自己找到了答案。把它张贴在这里，以便它可以对某人有所帮助。 .Address(External:=True) 和 .SeriesCollection(1).DataLabels.ShowRange = True 需要添加到代码中。请参阅下面的调整后工作正常的代码。我只更改了代码的最后两行。

Sub Chart()
Dim ChRng As Range

LastRow = Cells(Rows.Count, "E").End(xlUp).Row

Range("E3").Select
Range(ActiveCell.Address, Cells(LastRow, 
ActiveCell.Column)).Select
Range(Selection, Selection.Offset(0, 2)).Select
Set ChRng = Selection
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=ChRng

ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Text = "Top Five Merchants of the Day"
ActiveChart.ChartTitle.Text = "Top Five Merchants of the Day"
Selection.Format.TextFrame2.TextRange.Characters.Text = _
"Top Five Merchants of the Day"
 With Selection.Format.TextFrame2.TextRange.Characters(1, 29).Font
.BaselineOffset = 0
.Bold = msoFalse
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(89, 89, 89)
.Fill.Transparency = 0
.Fill.Solid
.Size = 14
.Italic = msoFalse
.Kerning = 12
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Spacing = 0
.Strike = msoNoStrike
End With

For Each cht In ActiveSheet.ChartObjects
cht.Name = "Chart 11"
Next cht

ActiveChart.ChartArea.Select
ActiveSheet.Shapes("Chart 11").ScaleWidth 1.45, msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes("Chart 11").ScaleHeight 1.28125, msoFalse, _
msoScaleFromTopLeft
ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Left = ActiveChart.ChartArea.Width
ActiveChart.ChartTitle.Left = ActiveChart.ChartTitle.Left / 2
ActiveChart.FullSeriesCollection(1).Select
ActiveChart.FullSeriesCollection(1).ApplyDataLabels
ActiveChart.FullSeriesCollection(1).DataLabels.Select
Selection.Separator = "" & Chr(13) & ""
Application.CutCopyMode = False
ActiveChart.FullSeriesCollection(1).DataLabels.Select

.SeriesCollection(1).DataLabels.Format.TextFrame2.TextRange. _
    InsertChartField msoChartFieldRange, Range(Range("H4"), 
 Range("H4").End(xlDown)).Address(External:=True), 0
.SeriesCollection(1).DataLabels.ShowRange = True

End Sub

向柱形图添加额外的数据标签

1 个答案: