使用第 1 行合并单元格中的文本为多个图表提供标题

Question

http://bit.ly/1CG7T4c 此 link 显示了我通过运行下面给出的代码获得的示例数据和图表。我有动态的部门数量。

我希望每个图表都将标题作为各自的部门名称，即在每个图表数据上方的每个合并单元格中给出的名称。

请给我推荐一个相同的代码。

 Option Explicit

 Sub PlotSeparateChartsByMergedFirstRow()
 Dim rUsed As Range, rMerged As Range, rChtData As Range
 Dim rChtDat1 As Range, rChtDat2 As Range
 Dim iColMerge As Long, iColData As Long
 Dim cht1 As Chart, cht2 As Chart

 Const iChtHeight As Double = 175

 Set rUsed = ActiveSheet.UsedRange
 iColMerge = 1

 Do
 iColMerge = iColMerge + 1
 If iColMerge > rUsed.Columns.Count Then Exit Do

 If rUsed.Cells(1, iColMerge).MergeCells Then
 Set rMerged = rUsed.Cells(1, iColMerge).MergeArea
 Set rChtData = rMerged.Resize(rUsed.Rows.Count)

 ' x values
 Set rChtDat1 = rUsed.Columns(1)
 Set rChtDat2 = rUsed.Columns(1)

 ' y values
 For iColData = 1 To rChtData.Columns.Count - 1 Step 2
 Set rChtDat1 = Union(rChtDat1, rChtData.Columns(iColData))
 Set rChtDat2 = Union(rChtDat2, rChtData.Columns(iColData + 1))
 Next

 ' charts
 ' 2007, 2010
 Set cht1 = ActiveSheet.Shapes.AddChart(xlColumnClustered, rChtData.Left,        rChtData.Height, rChtData.Width, iChtHeight).Chart

 With cht1
 .SetSourceData rChtDat1, xlColumns
 End With

 ' 2007, 2010
 Set cht2 = ActiveSheet.Shapes.AddChart(xlColumnClustered, rChtData.Left, rChtData.Height + iChtHeight, rChtData.Width, iChtHeight).Chart

 With cht2
 .SetSourceData rChtDat2, xlColumns
 End With

 nd If
 iColMerge = iColMerge + rMerged.Columns.Count - 1
 Loop

 End Sub

Answer 1

确保图表有标题，然后link第一行中合并块的第一个单元格的标题。

With cht1
    .SetSourceData rChtDat1, xlColumns
    .HasTitle = True
    .ChartTitle.Text = "=" & rUsed.Cells(1, iColMerge).Address(, , , True)
End With

使用第 1 行合并单元格中的文本为多个图表提供标题

Give title to multiple charts with the text in the merged cells in row 1

excel

charts

vba

title