Excel实战技巧107：识别工作簿中所有图表的详细信息
excelperfect
本文主要讲解如何使用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，供有兴趣的朋友参考。
欢迎到知识星球：完美Excel社群，进行技术交流和提问，获取更多电子资料。