新浪博客

操作形状的VBA代码

2022-08-15 06:00阅读：

http://blog.sina.cn/dpool/blog/u/2334711717

学习Excel技术


Excel提供了多种多样的形状类型，如下图1所示。本文主要讲述VBA操作形状的基础操作。
操作形状的VBA代码
图1
Shape对象
每个形状就是一个Shape对象，工作表中的所有Shape对象组成了Shapes集合。如下图2所示，在工作表中绘制了3个不同的形状，我们可以使用VBA代码遍历这些形状并获取它们的名称：
Sub testShape() Dim shp As Shape Dim str As String For Each shp InActiveSheet.Shapes str = str &shp.Name & vbCrLf Next shp MsgBox '工作表中的3个形状名称依次为:' & vbCrLf & str End Sub

运行上述代码的结果如下图2所示。
操作形状的VBA代码

图2
可以通过名称或索引值来访问Shape对象，例如代码：
MsgBox ActiveSheet.Shapes(1).Name
得到工作表中第1个形状的名称。在图2中的示例运行后的结果如下图3所示，即矩形的名称。
操作形状的VBA代码
图3
在上图2所示的工作表中运行代码：
ActiveSheet.Shapes('Right Arrow 2').Select 结果如下图4所示。
操作形状的VBA代码
图4
代码运行后，选取了右箭头。注意到，名称框中箭头的名称为“箭头:右2”，但运用到代码中的实际名称为“Right Arrow 2”。
添加Shape对象
在工作表中添加Shape对象，使用AddShape方法，其语法为：
Worksheet对象.Shapes.AddShape(AutoShapeType, Left, Top, Width, Height)
其中：
  • 参数AutoShapeType是一个代表不同形状的常量，取值为1至137和139至183，不能取138。
  • 参数Left和Top分别代表形状距离工作表左侧和顶部的距离，以磅为单位。
  • 参数Width和Height分别代表形状的宽度和高度，以磅为单位。
下面的代码在工作表中绘制了所有内置形状并标出了其常量值：
Sub CreateAutoShapes() Dim i As Integer Dim j As Integer Dim t As Integer Dim shp As Shape t = 10 j = 0 For i = 1 To 137 Set shp =ActiveSheet.Shapes.AddShape(i, 100 + j, t, 60, 60) shp.TextFrame.Characters.Text = i j = j + 80 If j = 800 Then j = 0 t = t + 70 End If Next ' 跳过 138- 不支持 j = 0 t = t + 70 If CInt(Application.Version) >= 12 Then For i = 139 To 183 Set shp =ActiveSheet.Shapes.AddShape(i, 100 + j, t, 60, 60) shp.TextFrame.Characters.Text = i j = j + 80 If j = 800 Then j = 0 t = t + 70 End If Next End If End Sub

运行上述代码后的结果如下图5所示，以每排10个形状依次列出。
操作形状的VBA代码
图5
可以编写一个自定义函数，在指定的单元格中插入特定的形状。自定义函数代码为：
Function AddShapeToRange( _ ShapeType As MsoAutoShapeType, _ sAddress As String) As Shape With ActiveSheet.Range(sAddress) Set AddShapeToRange =_ ActiveSheet.Shapes.AddShape( _ ShapeType, _ .Left, .Top, .Width,.Height) End With End Function

下面的代码调用AddShapeToRange函数并在单元格B2中插入一个笑脸形状：
Sub testAddShapeFunc() Dim shp As Shape Set shp =AddShapeToRange(17, 'B2') End Sub

运行效果如下图6所示。
操作形状的VBA代码
图6
在形状中添加文本
可以使用Shape对象的TextFrame属性和TextFrame2属性在形状中添加文本。下面的示例代码在工作表中创建一个心形并添加格式化文本：
Sub AddTextToShape() Dim shp As Shape Dim txt As String Set shp = ActiveSheet.Shapes.AddShape(21,50, 30, 100, 100) txt = '完美Excel' If Len(txt) > 0 Then With shp.TextFrame .Characters.Text =txt .Characters.Font.Size = 12 .Characters.Font.Bold = True .HorizontalAlignment= xlHAlignCenter End With End If End Sub

运行代码后的效果如下图7所示。
操作形状的VBA代码
图7
设置形状的边框和填充样式
下面的代码在工作表中添加一个圆柱形并设置样式：
Sub AddShapeAndSetStyle() Dim shp As Shape Dim txt As String Set shp =ActiveSheet.Shapes.AddShape(13, 50, 30, 100, 100) shp.ShapeStyle =msoShapeStylePreset16 End Sub

运行代码后的效果如下图8所示。
操作形状的VBA代码
图8
代码中，使用了ShapeStyle属性来指定形状的填充样式。其一般形式为：
shape对象.ShapeStyle = msoShapeStylePresetXX
其中的XX是样式编号，从1至42，对应的样式如下图9所示，顺序为从左至右、自上至下。
操作形状的VBA代码
图9
此外，还有35个预设样式，如下图10所示，对应的编号为43至78，顺序为从左至右、自上至下。
操作形状的VBA代码
图10
添加连接线连接形状
有两种方法来连接形状：连接线和线条。其中连接线是特殊的用于连接形状的线条，如果移动形状，连接线也跟随着相应的移动保持与形状相连。
在形状之间添加线条的语法很简单：
Worksheet对象.Shapes.AddLine(BeginX, BeginY, EndX, EndY)
然而，添加连接线则复杂些。下面的代码计算起点和终点，创建连接线，将连接线连接到两个形状，最后执行重新规划以确保是最短路径。
Function AddConnectorBetweenShapes( _ ConnectorType AsMsoConnectorType, _ oBeginShape As Shape, _ oEndShape As Shape) AsShape Const TOP_SIDE As Integer= 1 Const BOTTOM_SIDE AsInteger = 3 Dim oConnector As Shape Dim x1 As Single Dim x2 As Single Dim y1 As Single Dim y2 As Single With oBeginShape x1 = .Left + .Width /2 y1 = .Top + .Height End With With oEndShape x2 = .Left + .Width /2 y2 = .Top End With IfCInt(Application.Version) <</span> 12 Then x2 = x2 - x1 y2 = y2 - y1 End If Set oConnector =ActiveSheet.Shapes.AddConnector(ConnectorType, x1, y1, x2, y2) oConnector.ConnectorFormat.BeginConnectoBeginShape, BOTTOM_SIDE oConnector.ConnectorFormat.EndConnect oEndShape, TOP_SIDE oConnector.RerouteConnections SetAddConnectorBetweenShapes = oConnector Set oConnector = Nothing End Function

其中：
  • 参数ConnectorType是下列常量之一：msoConnecto

我的更多文章

下载客户端阅读体验更佳

APP专享