VBA, чтобы установить имя серии диаграммы на имя столбца таблицы вместо Series1,2,3, - PullRequest
Новая
       40

VBA, чтобы установить имя серии диаграммы на имя столбца таблицы вместо Series1,2,3,

0 голосов
/ 19 октября 2018

В Excel 2010 у меня есть следующий код, который создает диаграмму («Диаграмма данных BMS») на отдельном листе из данных таблицы («BMS_Data»).Все работает хорошо, кроме названий серий диаграмм: Series1, Series2 и т. Д. Как я могу использовать VBA, чтобы установить в этих именах серий имя заголовка столбца таблицы во время создания? 

Sub createBMSChart()
Dim cht As ChartObject
Dim ws As Worksheet
Dim myCht As ChartObject
Dim objSeries As Series
Dim srs As Series
Dim cWs As Worksheet
Dim tbl As Range

Sheets.add after:=Worksheets("BMS Data")
ActiveSheet.Name = "BMS Data Chart"

Set cWs = ActiveSheet
cWs.Tab.Color = vbGreen

Set ws = Worksheets("BMS Data")
Set tbl = ws.Range("BMS_Data")

Set cht = cWs.ChartObjects.add(Left:=10, Width:=1300, Top:=10, Height:=550)
cht.Chart.SetSourceData Source:=tbl
cht.Name = "BMS Data Chart"
Set myCht = cht

    With myCht.Chart
    .ChartType = xlLine
    .HasTitle = True
    .ChartTitle.Text = "BMS Data Chart"
    .Legend.Position = xlBottom
    .Axes(xlCategory).CategoryType = xlCategoryScale
    .Axes(xlCategory).TickLabelPosition = xlLow
    .Axes(xlCategory).MajorTickMark = xlNone
    .Axes(xlCategory).AxisBetweenCategories = False
    End With


    For Each srs In cWs.ChartObjects("BMS Data Chart").Chart.SeriesCollection
        srs.Format.Line.Weight = 1

    Next

cWs.Activate
End Sub

Partial Table Data Current Chart Image

1 Ответ

0 голосов
/ 19 октября 2018

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

Sub createBMSChart()

Dim cht As ChartObject
Dim ws As Worksheet
Dim myCht As ChartObject
Dim objSeries As Series
Dim srs As Series
Dim cWs As Worksheet
Dim tbl As ListObject

Sheets.Add after:=Worksheets("BMS Data")
ActiveSheet.Name = "BMS Data Chart"

Set cWs = ActiveSheet
cWs.Tab.Color = vbGreen

Set ws = Worksheets("BMS Data")
Set tbl = ws.ListObjects("Table1")          '********************************************

Set cht = cWs.ChartObjects.Add(Left:=10, Width:=1300, Top:=10, Height:=550)
cht.Chart.SetSourceData Source:=tbl.Range   '********************************************
cht.Name = "BMS Data Chart"
Set myCht = cht

With myCht.Chart
    .ChartType = xlLine
    .HasTitle = True
    .ChartTitle.Text = "BMS Data Chart"
    .Legend.Position = xlBottom
    .Axes(xlCategory).CategoryType = xlCategoryScale
    .Axes(xlCategory).TickLabelPosition = xlLow
    .Axes(xlCategory).MajorTickMark = xlNone
    .Axes(xlCategory).AxisBetweenCategories = False
End With

For Each srs In cWs.ChartObjects("BMS Data Chart").Chart.SeriesCollection
    srs.Format.Line.Weight = 1
Next

cWs.Activate

End Sub

enter image description here

...