需要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

数据

<强>截图