Блог

Главная - Вопросы по программированию - Добавьте дополнительную метку данных в столбчатую диаграмму

Добавьте дополнительную метку данных в столбчатую диаграмму

#excel #vba #charts

Вопрос:

Я пытаюсь правильно использовать код VBA для создания диаграммы и добавления дополнительной метки данных в каждый столбец диаграммы. Я попытался записать макрос для этого, а затем изменить его в соответствии со своими потребностями. Я не получаю никакого сообщения об ошибке. Все идет правильно, за исключением ввода описания изображения здесь, добавив эту дополнительную метку данных.

Вот что у меня есть.

 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 = "" amp; Chr(13) amp; ""
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

Ответ №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 = "" amp; Chr(13) amp; ""
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
Метки: