VBA专题01：操作形状的VBA代码
学习Excel技术，关注微信公众号：
excelperfect
Excel提供了多种多样的形状类型，如下图1所示。本文主要讲述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所示。
图2
可以通过名称或索引值来访问Shape对象，例如代码：
MsgBox ActiveSheet.Shapes(1).Name
得到工作表中第1个形状的名称。在图2中的示例运行后的结果如下图3所示，即矩形的名称。
图3
在上图2所示的工作表中运行代码：
ActiveSheet.Shapes("Right Arrow 2").Select 结果如下图4所示。
图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个形状依次列出。
图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所示。
图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所示。
图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所示。
图8
代码中，使用了ShapeStyle属性来指定形状的填充样式。其一般形式为：
shape对象.ShapeStyle = msoShapeStylePresetXX
其中的XX是样式编号，从1至42，对应的样式如下图9所示，顺序为从左至右、自上至下。
图9
此外，还有35个预设样式，如下图10所示，对应的编号为43至78，顺序为从左至右、自上至下。
图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) < 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是下列常量之一：msoConnectorCurve、msoConnectorElbow或msoConnectorStraight。
- 通常不需要计算起点和终点，可以为addConnector()函数输入任何值，因为一旦调用BeginConnect方法和EndConnect方法，连接线将附加到形状，并且将自动设置起点和终点。
- Excel版本之间指定终点坐标的方式不一致。在Excel2007之前，终点坐标是相对于起点坐标的。从Excel2007开始，该函数使用绝对坐标。
- 将连接器连接到形状时，需要使用连接位置常量指定侧边。对于每种形状类型，常量都是不同的，但通常从顶边=1开始，逆时针旋转。例如，大多数矩形都具有连接位置常量，其中Top=1、Left=2、Bottom=3和Right=4。
- 调用RerouteConnections()函数时，会自动设置连接位置，以便在两个形状之间创建最短路径。因此，除非想要一个特定的线路，否则通常可以猜测连接位置的值，然后调用RerouteConnections()。
下面的代码调用AddConnectorBetweenShapes函数：
Sub testConn()
Dim shp As Shape
Dim shp1 As Shape
Dim shp2 As Shape
Set shp1 =ActiveSheet.Shapes.AddShape(9, 50, 30, 50, 50)
Set shp2 =ActiveSheet.Shapes.AddShape(21, 200, 120, 50, 50)
Set shp =AddConnectorBetweenShapes(msoConnectorCurve, shp1, shp2)
End Sub运行代码后的结果如下图11所示。
图11
格式化连接线和线条
下面是Excel 2003版本与Excel 2007及以上版本中格式化连接线与线条的代码，在Excel 2007及以上的版本中相对更简单。
Sub FormatConnector2003(oConnector As Shape)
With oConnector
If .Connector Or .Type =msoLine Then
.Line.EndArrowheadStyle= msoArrowheadTriangle
.Line.Weight = 2
.Line.ForeColor.RGB =RGB(192, 80, 77)
.Shadow.Type =msoShadow6
.Shadow.IncrementOffsetX-4.5
.Shadow.IncrementOffsetY-4.5
.Shadow.ForeColor.RGB =RGB(192, 192, 192)
.Shadow.Transparency =0.5
.Visible = msoTrue
End If
End With
End Sub
Sub FormatConnector2007(oConnector As Shape)
With oConnector
If .Connector Or .Type =msoLine Then
.Line.EndArrowheadStyle= msoArrowheadTriangle
.ShapeStyle =msoLineStylePreset17
End If
End With
End Sub上面代码中的Connector属性返回一个布尔值，指示形状是否为连接线。Type=msoLine语句检查形状是否为线条。此时，代码将以相同的方式格式化连接线和线条。当然，你也可以分别处理它们。
与形状样式一样，可以设置ShapeStyle属性的值为msoLineStylePresetXX来设置线条样式，其中XX代表样式库中的编号。
Line对象除了代码中的EndArrowheadStyle属性之外，还有BeginarRowHeadStyle属性、DashStyle属性以及允许创建双线的Style属性等较为有用的属性。
注：本文学习整理自peltiertech.com。