Excel实战技巧107：识别工作簿中所有图表的详细信息

本文主要讲解如何使用VBA识别图表的详细信息并将结果呈现给用户，所编写的程序需要报告图表的下列特征：

• 图表所在的工作表
• 图表对象的名称
• 不同数据系列列表
• 每个数据系列的公式
• 每个项目的坐标轴公式
• 任何可能应用于像气泡图等的X/Y/Z坐标轴公式

如果手动来确认，对于包含很多图表的工作簿来说，其工作量是非常大的，因此使用VBA能够极大地提高效率。

要实现上述结果，可以按下面的步骤：

• 定义目标/输出文件，保存目标详细信息
• 确定系列细节并循环提取它们
• 从公式中提取出相关名称/y轴/x轴/气泡大小并清理

首先，我们需要定义包含图表的文件，以及我们想要存储结果的位置。为了让程序正常工作，我们不想修改基本文件，因此我们将创建一个新工作簿来存储结果。

可以使用命令：

‘定义包含图表的文件

Set TargetWorkbook = ActiveWorkbook

Workbooks.Add

‘定义输出工作簿

Set OutputWorkbook = ActiveWorkbook

ActiveWorkbook引用当前处于活动状态的Excel文件（即Excel当前处于激活状态的文件，并将对其执行操作）。假设在查看工作簿时正在运行这个宏，可以将第一个变量TargetWorkbook设置为该文件。

接着，Workbooks.Add将创建一个新的空白Excel文件，可以将其定义为OutputWorkbook。

定义Excel文件允许我们使用OutputWorkbook.Activate和TargetWorkbook.Activate在文件之间切换，因为需要查看Target以查找图表信息，然后切换回Output以存储结果。

然后，我们所需要做的就是确定要存储在输出中的详细信息，并设置我们需要的标题，以使输出文件准备好接受输入。

‘保存目标文件名

OutputWorkbook.Activate

Range(“A1”).Value = “文件:”

Range(“B1”).Value = TargetWorkbook.Name

Range(“A6”).Value = “工作表”

Range(“B6”).Value = “图表”

Range(“C6”).Value = “系列”

Range(“D6”).Value = “公式”

Range(“E6”).Value = “名称”

Range(“F6”).Value = “Y轴”

Range(“G6”).Value = “X轴”

Range(“H6”).Value = “气泡大小”

Range(“A6:H6”).Font.Bold = True

随后我们要做另一件事——创建命名区域，我们可以用它来定义我们的输出从哪里开始，并考虑包含多少行。

至此，已经确定了工作簿，并设置了输出页面以开始获取详细信息，接下来是返回到目标工作簿并开始循环查找所有图表的代码。

在程序中，我们需要运行几个循环：

• 需要遍历每个工作表（变量：“sh”）
• 需要查找每个工作表中的每个图表（变量：“ch”）
• 需要查找每个工作表中每个图表的每个数据系列的详细信息（变量：“srs”）

因此，对于每个系列，我们想要记录工作表名称、图表名称、它是什么系列以及用于获取该系列数据的公式。

SheetValue = sh.Name

ChartValue = ch.Name

SeriesValue = srs.Name

FormulaValue = srs.Formula

现在，对于我们的程序以及记录结果的目的，例如，如果数据系列为空，那么我们不希望程序记录一个完全空白的单元格，因为它破坏了我们的命名区域工作去确定有多少行的方式。所以，我们可以用一个空格替换任何空，并记录我们的结果。

‘如果没有值,插入空格替代以便下一个项目合适地工作

If SheetValue = “” Then SheetValue = “ “

If ChartValue = “” Then ChartValue = “ “

If SeriesValue = “” Then SeriesValue = “ “

If FormulaValue = “” Then FormulaValue = “ “

‘输入值到工作簿

OutputWorkbook.Activate

Range(“SheetNextItem”) = SheetValue

Range(“ChartNextItem”) = ChartValue

Range(“SeriesNextItem”) = SeriesValue

Range(“FormulaNextItem”) = “’” & FormulaValue

‘将视图重置为目标工作簿以移至下一个系列

TargetWorkbook.Activate

接着，一旦记录了值，我们可以切换到新工作簿，根据命名区域规则将值设置在适当的位置，然后返回目标工作簿查看下一个数据系列和下一个图表。

整个循环部分的代码如下所示：

For Each sh In TargetWorkbook.Sheets

Sh.Activate

‘遍历每个图表对象

For Each ch In sh.ChartObjects

ch.Activate

‘查找图表对象中的每个系列

For Each srs In ActiveChart.SeriesCollection

SheetValue= sh.Name

ChartValue= ch.Name

SeriesValue= srs.Name

On Error Resume Next

FormulaValue= srs.Formula

On Error GoTo 0

If FormulaValue = “” And SeriesValue <> “” Then

FormulaValue= “Excel图表: 不能识别系列”

End If

‘如果没有值,插入空格替代以便下一个项目合适地工作

If SheetValue = “” Then SheetValue = “ “

If ChartValue = “” Then ChartValue = “ “

If SeriesValue = “” Then SeriesValue = “ “

If FormulaValue = “” Then FormulaValue = “ “

‘输入值到工作簿

OutputWorkbook.Activate

Range(“SheetNextItem”)= SheetValue

Range(“ChartNextItem”)= ChartValue

Range(“SeriesNextItem”)= SeriesValue

Range(“FormulaNextItem”)= “’” & FormulaValue

‘将视图重置为目标工作簿以移至下一个系列

TargetWorkbook.Activate

Nextsrs

Next ch

Next sh

实际上，我们选择了一个工作表，然后选择该工作表中的第一个图表对象，遍历所有数据系列以确定详细信息。一旦我们完成了那个图表，就可以移动到下一个图表，一旦该工作表遍历完成，就可以移动到下一工作表。

注意，SeriesCollection.Formula不适用于新的Excel2016图表类型。这就是为什么在我们的最终代码中，使用了错误捕捉来检查。

至此，到最后一步了，即清理输出页面并计算出数据系列中的所有移动部分。

现在，我们已经从工作簿的图表中提取了详细信息，并将它们放入一个看起来像下面这样的新工作簿中：

从这里开始，我们需要解开公式以计算出数据系列的组成部分是什么。幸运的是，有一些基本规则：

• 公式总是以“=SERIES(”开始
• 数据系列的名称将作为第一个参数（即第一个逗号之前）
• 紧接着总是Y轴、X轴、任何气泡大小或Z轴（如果相关）
• 以一个数字结束，指示它在系列项目列表中的位置

因此，我们可以使用公式来计算出每个组件是什么。所以在Name列下，我们可以使用以下公式来提取名称：

Name：=IFERROR(MID(D7,FIND("(",D7)+1,FIND(",",D7,FIND("(",D7)+1)-FIND("(",D7)-1),"n.a.")

然后，我们也可以对坐标轴项重复这些步骤：

Y轴:=IFERROR(MID(D7,FIND(",",D7,FIND("(",D7)+1)+1,FIND(",",D7,FIND(",",D7,FIND("(",D7)+1)+1)-FIND(",",D7,FIND("(",D7)+1)-1),"n.a.")

X轴:=IFERROR(MID(D7,FIND(",",D7,FIND(",",D7,FIND("(",D7)+1)+1)+1,FIND(",",D7,FIND(",",D7,FIND(",",D7,FIND("(",D7)+1)+1)+1)-FIND(",",D7,FIND(",",D7,FIND("(",D7)+1)+1)-1),"n.a.")

气泡大小：=IFERROR(MID(D7,FIND(",",D7,FIND(",",D7,FIND(",",D7,FIND("(",D7)+1)+1)+1)+3,LEN(D7)-FIND(",",D7,FIND(",",D7,FIND(",",D7,FIND("(",D7)+1)+1)+1)-3),"n.a.")

所有这些公式基本上都是查找相关逗号和括号的位置，以便找到每个图表系列详细信息的起点和终点。为了将它们构建到代码中，我们需要：

Range("NameStart").Offset(1, 0).Formula ="=IFERROR(MID(D7,FIND(""("",D7)+1,FIND("","",D7,FIND(""("",D7)+1)-FIND(""("",D7)-1),""n.a."")"

Range("YAxisStart").Offset(1, 0).Formula="=IFERROR(MID(D7,FIND("","",D7,FIND(""("",D7)+1)+1,FIND("","",D7,FIND("","",D7,FIND(""("",D7)+1)+1)-FIND("","",D7,FIND(""("",D7)+1)-1),""n.a."")"

Range("XAxisStart").Offset(1, 0).Formula= "=IFERROR(MID(D7,FIND("","",D7,FIND("","",D7,FIND(""("",D7)+1)+1)+1,FIND("","",D7,FIND("","",D7,FIND("","",D7,FIND(""("",D7)+1)+1)+1)-FIND("","",D7,FIND("","",D7,FIND(""("",D7)+1)+1)-1),""n.a."")"

Range("BubbleStart").Offset(1, 0).Formula= "=IFERROR(MID(D7,FIND("","",D7,FIND("","",D7,FIND("","",D7,FIND(""("",D7)+1)+1)+1)+3,LEN(D7)-FIND("","",D7,FIND("","",D7,FIND("","",D7,FIND(""("",D7)+1)+1)+1)-3),""n.a."")"

一旦公式写好了，我们就可以向下复制，然后复制并粘贴特殊值作为值。

Range(“NameRange”).FillDown

Range(“YAxisRange”).FillDown

Range(“XAxisRange”).FillDown

Range(“BubbleRange”).FillDown

Application.Calculate

Range(“NameRange”, “BubbleRange”).Copy

Range(“NameRange”, “BubbleRange”).PasteSpecialxlPasteValues

此外，如果工作簿中没有图表，公式就会崩溃。在这种情况下，我们可能只想要一个简单的消息，让用户知道没有图表。

‘如果没有图表,转到结束

If Range(“SheetStart”).Offset(1, 0).Value = “” Then

Range(“SheetStart”).Offset(1,0).Value = “没有找到图表.”

GoToEndMacro

End If

最后，剩下的就是一些代码来整理和重置屏幕更新和计算状态。

Columns(“A:H”).EntireColumn.AutoFit

On Error GoTo 0

EndMacro:

Application.ScreenUpdating = True

Application.Calculation = StartingCalculation

Range(“A1”).Select

End Sub

注：本文学习整理自www.sumproduct.com，供有兴趣的朋友参考。