需要 VBA excel 图表代码来包含标题和图例标签

Question

以下代码为所有数据行生成单独的圆环图，但我们需要它包含每行中的第一个单元格作为标题，并包含相应图例标签的列标题。我们在 VBA 方面没有经验，并试图对其进行调整，但没有成功。如果重要的话，我们的最终用户拥有 Excel 2010。我希望这是一个简单的修复/编辑。有人能帮忙吗？？

样本数据：

名称----数据1----数据2----数据3

约翰____23______32_____14

特里___456____125____104

迈克____109______6______98

代码：

Sub AutoCreateCharts()
    Dim i As Long
    Dim LastRow As Long
    Dim LastColumn As Long
    Dim chrt As Chart
    LastRow = Sheets("Sheet1").Range("A3000").End(xlUp).Row
    LastColumn = Sheets("Sheet1").Range("A1").End(xlToRight).Column

    For a = 2 To LastRow
        Sheets("Sheet2").Select
        Set chrt = Sheets("Sheet2").Shapes.AddChart.Chart
        chrt.ChartType = xlDoughnut
        With Sheets("Sheet1")
            chrt.SetSourceData Source:=.Range(.Cells(a, 2), .Cells(a, LastColumn))
        End With

        chrt.ChartArea.Left = 1
        chrt.ChartArea.Top = (a - 2) * chrt.ChartArea.Height
    Next    
End Sub 

Answer 1

要添加Title，请使用.HasTitle = True，然后使用.ChartTitle.Text 设置文本

要添加图例，请使用.HasLegend = True。但这还不够。您需要将源数据设置为包含标题行，以便代码可以自动捕获系列名称。

这是你正在尝试的吗？

Sub AutoCreateCharts()
    Dim i As Long, LastRow As Long, LastColumn As Long
    Dim chrt As Chart
    Dim rng As Range

    LastRow = Sheets("Sheet1").Range("A3000").End(xlUp).Row
    LastColumn = Sheets("Sheet1").Range("A1").End(xlToRight).Column

    For i = 2 To LastRow
        Set chrt = Sheets("Sheet2").Shapes.AddChart.Chart

        chrt.ChartType = xlDoughnut
        chrt.HasLegend = True '<~~ Add the legend

        With Sheets("Sheet1")
            '~~> Include the First row in the source data
            chrt.SetSourceData Source:=Union(.Range(.Cells(1, 2), .Cells(1, LastColumn)), _
                                             .Range(.Cells(i, 2), .Cells(i, LastColumn)))

            chrt.HasTitle = True '<~~ Add the Chart Title
            chrt.ChartTitle.Text = .Cells(i, 1).Value '<~~ Set the text
        End With

        chrt.ChartArea.Left = 1
        chrt.ChartArea.Top = (a - 2) * chrt.ChartArea.Height
    Next
End Sub

数据

截图