大家好，我们今日讲解"VBA信息获取与处理"教程中第十九个专题"工作表中对SHAPE信息的获取及处理"的第1节"遍历工作表中所有形状并输出信息"，这个专题是非常实用的知识点，希望大家能掌握利用。教程会提供配套的程序文件。

第一节 遍历工作表中所有形状并输出信息

这讲我们讲解如何遍历一个工作表中所有的形状并输出形状的信息。我们处理一个带有形状的工作表时，有时候需要每个形状的基本信息，然后加以利用处理。对于形状信息的捕获，有很多的方法，这讲介绍给大家的是利用ShapeRange对象的属性和方法来完成。

1 遍历工作表中所有形状的必要语句

1)Shapes 对象，返回指定工作表上的所有Shape对象的集合。

每个 Shape 对象都代表绘图层中的一个对象，如自选图形、任意多边形、OLE对象或图片。使用工作表对象的Shapes属性就可以返回这个工作表的Shapes集合。使用Shapes (index),其中index是形状的名称或索引号, 返回单个形状对象。

参考语句：

Set myDocument = Worksheets(1)

myDocument.Shapes.SelectAll

将返回工作表的所有形状

Set myDocument = Worksheets(1)

myDocument.Shapes.Range(Array(1, 3)).Fill.Patterned _

msoPatternHorizontalBrick

上述代码将设置形状一和三的填充图案。

备注：从工作表的 Shapes 或OLEObjects集合返回控件时，必须使用形状名称而不是代码名称来通过名称引用控件。例如，假定要向工作表添加一个复选框，默认的形状名称和代码名称都是 CheckBox1。然后，如果你通过在"属性"窗口的"(名称)"旁边键入"chkFinished"更改了控件代码名称，则在事件过程名称中必须使用chkFinished，但是你仍然需要使用 CheckBox1 从 Shapes 或OLEObject集合中返回控件，如下例所示。

Private Sub chkFinished_Click()

ActiveSheet.OLEObjects("CheckBox1").Object.Value = 1

End Sub

2)Count属性，返回一个 Long 值，它代表集合中对象的数量。

语法：expression.Count

参数：expression：一个表示 Shapes对象的变量。

3)RANGE 属性，返回一个ShapeRange对象，表示的形状是Shapes 集合中的一个子集。

语法：expression.Range (Index)

参数：

expression：一个表示 Shapes 对象的变量。

Index必需Variant 包含在该区域中的各单个形状，可以是指定形状索引号的整数、指定形状名称的字符串，也可以是包含整数或字符串的数组。

备注：虽然您可以使用Range属性返回任意数量的形状, 但如果只想返回集合中的单个成员, 则使用Item方法更为简单。例如，Shapes(1)是比Shapes.Range(1)更简单。

若要指定Index的整数或字符串的数组，可以使用 Array 函数。例如，下列指令返回由名称指定的两个形状。

Dim arShapes() As Variant

Dim objRange As Object

arShapes = Array("Oval 4", "Rectangle 5")

Set objRange = ActiveSheet.Shapes.Range(arShapes)

注意点：在 Microsoft Excel 中，不能用此属性返回包含工作表上的所有 Shape 对象的ShapeRange对象。相反, 请使用以下代码：Worksheets(1).Shapes.SelectAll

4)ShapeRange.Type属性，返回一个MsoShapeType值, 该值代表形状的类型。

对于这个MsoShapeType值，我给出下面的列表：

名称 值 说明(英语) 说明(汉语)

mso3DModel 30 3D model 3d 模型

msoAutoShape 1 AutoShape 对象

msoCallout 2 Callout 标注

msoCanvas 20 Canvas 画布

msoChart 3 Chart 图表

msoComment4 Comment 批注

msoContentApp 27 Content Office Add-in 内容 Office 加载项

msoDiagram 21 Diagram 规划

msoEmbeddedOLEObject 7 Embedded OLE object 嵌入式 OLE 对象

msoFormControl 8 Form control 表单控件

msoFreeform 5 Freeform 任意多边形

msoGraphic 28 Graphic 图形

msoGroup 6 Group Group

msoIgxGraphic 24 SmartArt graphic SmartArt 图形

msoInk 22 Ink墨迹

msoInkComment 23 Ink comment 墨迹批注。

msoLine 9 Line 线条。

msoLinked3Dmodel 31 Linked 3D model 链接的3d 模型

msoLinkedGraphic 29 Linked graphic 链接的图形

msoLinkedOLEObject 10 Lked OLE object 链接 OLE 对象。

msoLinkedPicture 11 Linked picture链接图片。

msoMedia 16 Media 媒体

msoOLEControlObject 12 OLE control object OLE 控件对象。

msoPicture 13 Picture 图片

msoPlaceholder 14 Placeholder 占位符

msoScriptAnchor 18 Script anchor 脚本定位标记。

msoShapeTypeMixed -2 Mixed shape type 混和形状类型。

msoTable 19 Table Table

msoTextBox 17 Text box 文本框。

msoTextEffect 15 Text effect 文本效果。

msoWebVideo 26 Web videoWeb 视频

5) ShapeRange.AutoShapeType属性，返回或设置指定的shape 或ShapeRange对象的形状类型, 该对象必须代表除线条、任意多边形图形或连接符的自选图形。可读/写。对于

TYPE值中的msoAutoShape，这个对象又有不同的表示值。

语法：expression.AutoShapeType

Expression代表一个代表ShapeRange对象的变量。

对于AutoShapeType的值我给出列表，见本书的附表一，同时在专题提供的程序文件：019工作表.xlsm 中也有。

2 遍历工作表中所有形状的代码

为了遍历工作表1中的所有图形，我给出了下面的代码：

Sub mynz() '获取工作表中的所有Shape对象

Sheets("sheet1").Select

Cells.ClearContents

k = 2

Range("a1:e1") = Array("序号", "Name", "Type", "AutoShapeType", "说明")

With Sheets("sheet1").Shapes

For i = 1 To .Count

With .Range(i)

strShapeTypeConst = ""

Cells(k, 1) = i

Cells(k, 2) = .Name

Cells(k, 3) = .Type

Cells(k, 4) = .AutoShapeType

If .Type = 1 Then

Select Case .AutoShapeType

Case 5

strShapeTypeConst = "圆角矩形"

Case 142

strShapeTypeConst = "圆形 (饼图), 缺少部分"

Case 165

strShapeTypeConst = "乘号x"

Case 90

strShapeTypeConst = "爆炸"

Case 14

strShapeTypeConst = "集"

Case 102

strShapeTypeConst = "水平滚动"

Case 92

strShapeTypeConst = "五角星"

End Select

Else

Select Case .Type

Case 5

strShapeTypeConst = "任意多边形"

Case 3

strShapeTypeConst = "图表"

Case 9

strShapeTypeConst = "线条"

Case 13

strShapeTypeConst = "图片"

End Select

End If

End With

Cells(k, 5) = strShapeTypeConst

k = k + 1

Next

End With

MsgBox ("ok!")

End Sub

代码部分截图：

代码讲解：

1)上述代码实现了将工作表1中的所有图形遍历，并返回捕获的信息。

2)代码中采用了case语句以添加不同图形的说明。

3 遍历工作表中所有形状代码实现效果

我们在工作表1中有下面的各种图形，如下截图：

我们点击运行按钮，当然也是上述图形之一，会得到下面的结果：

由此，我们看出实现了遍历工作表中所有图形的目的；

本节知识点回向：

① 遍历工作表中所有图形的思路是怎样的？

② AutoShapeType属性和Type属性有什么不同？

本讲代码参考文件：019工作表.xlsm

积木编程的思路内涵：

在我的系列书籍中一直在强调"搭积木"的编程思路，这也是学习利用VBA的主要方法，特别是职场人员，更是要采用这种方案。其主要的内涵：

1 代码不要自己全部的录入。你要做的是把积木放在合适的位置然后去修正代码，一定要拷贝，从你的积木库中去拷贝，然后修正代码，把时间利用到高效的思考上。

2 建立自己的"积木库"。平时在学习过程中，把自己认为有用的代码放在一起，多积累，在用到的时候，可以随时拿来。你的积木库资料越多，你做程序的思路就会越广。

VBA的应用界定及学习教程：

VBA是利用Office实现个人小型办公自动化的有效手段(工具)。这是我对VBA的应用界定。在取代OFFICE新的办公软件没有到来之前，谁能在数据处理方面做到极致，谁就是王者。其中登峰至极的技能非VBA莫属！

我记得20年前自己初学VBA时，那时的资料甚少，只能看源码自己琢磨,真的很难。20年过去了，为了不让学习VBA的朋友重复我之前的经历，我根据自己多年VBA实际利用经验，推出了六部VBA专门教程，目前教程均通过32位和64位两种OFFICE系统测试。

第一套：VBA代码解决方案 是VBA中各个知识点的讲解，教程共147讲，覆盖绝大多数的VBA知识点，提供的程序文件更是一座不可多得的代码宝库，是初学及中级人员必备教程；目前这套教程提供的版本是修订第二版，程序文件通过32位和64位两种OFFICE系统测试。

第二套：VBA数据库解决方案 数据库是数据处理的专业利器，教程中详细介绍了利用ADO连接ACCDB和EXCEL的方法和实例操作，适合中级人员的学习。目前这套教程提供的是修订第一版教程，程序文件通过32位和64位两种OFFICE系统测试。

第三套：VBA数组与字典解决方案 数组和字典是VBA的精华，字典是VBA代码水平提高的有效手段，值得深入的学习，是初级及中级人员代码精进的手段。目前这套教程提供的版本是修订第一版，程序文件通过32位和64位两种OFFICE系统测试。

第四套：VBA代码解决方案之视频 是专门面向初学者的视频讲解，可以快速入门，更快的掌握这门技能。这套教程是第一套教程(修订一版)的视频讲解，听元音更易接受。这套教程还会额外提供通过32位和64位两种OFFICE系统测试的程序文件。

第五套：VBA中类的解读和利用 这是一部高级教程，讲解类的虚无与肉身的度化，类的利用虽然较少，但仔细的学习可以促进自己VBA理论的提高。这套教程的领会主要是读者的领悟了，领悟一种佛学的哲理。目前这套教程提供的版本是修订第一版，程序文件通过32位和64位两种OFFICE系统测试。

第六套教程：《VBA信息获取与处理》，这是一部高级教程，涉及范围更广，实用性更强，面向中高级人员。教程共二十个专题，包括：跨应用程序信息获得、随机信息的利用、电子邮件的发送、VBA互联网数据抓取、VBA延时操作，剪切板应用、Split函数扩展、工作表信息与其他应用交互，FSO对象的利用、工作表及文件夹信息的获取、图形信息的获取以及定制工作表信息函数等等内容。程序文件通过32位和64位两种OFFICE系统测试。

上述教程的学习顺序：1→3→2→6→5或者4→3→2→6→5。提供的程序文件更是一座巨大的代码库，供读者使用，如需要可以WeChat: NZ9668

学习VBA是个过程，也需要经历一种枯燥的感觉

"众鸟高飞尽，孤云独去闲。相看两不厌，只有敬亭山"。学习的过程也是修心的过程，修一个平静的心。在代码的世界中，心平静了，心情好了，身体自然而然就好。心静则正，内心里没有那么多邪知邪见，也就没有那么多妄想。利人就是利己。我的教程助力给正在努力的朋友。

"水善利万物而不争"，绵绵密密，微则无声，巨则汹涌。学习亦如此，知道什么是自己所需要的，不要蜷缩在一小块自认为天堂的世界里，待到暮年时再去做自欺欺人的言论。要努力提高自己，用一颗充满生机的心灵，把握现在，这才是进取。越是有意义的事情，困难会越多。愿力决定始终，智慧决定成败。不管遇到什么，都是风景。看淡纷争，看轻得失。学习时微而无声，利用时则巨则汹涌。"路漫漫其修远兮，吾将上下而求索"

每一分收获都是成长的记录，怎无凭，正是这种执着，成就了朝霞的灿烂。最后将一阙词送给致力于VBA学习的朋友,让大家感受一下学习过程的枯燥与执着：

浮云掠过，暗语无声，

唯有清风，惊了梦中啼莺。

望星，疏移北斗，

奈将往事雁同行。

阡陌人，昏灯明暗，

忍顾长亭。

多少VBA人，

暗夜中，悄声寻梦，盼却天明。

怎无凭！

分享我多年工作实际经验的成果，随喜这些有用的东西，给确实需要利用VBA的同路人。回向学习利用VBA的历历往事，不胜感慨，谨以这些文字以纪念，

分享成果，随喜正能量