跳转至

15 形状和图片

1）Shapes / Shape 到底是什么关系？

在 Excel VBA 里，图形体系基本是这样：

  • Worksheet.Shapes：一个集合（集合里装着所有 Shape）
  • Shape：集合里的单个图形对象（矩形、文本框、图片、按钮、图表对象……都算 Shape）

结论一句话： 在 Excel 里，“图片”本质上也是 Shape，只是 Shape 的类型不同。典型代码如下：

1
2
3
4
5
' 此代码用于打印活动工作表中的所有形状和具体类型编号
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
    Debug.Print shp.Name, shp.Type
Next
对于所有的形状，我这里整理了一张速查表，可以对照参考，带了数字的是编号简写：

形状（英文） 名称（中文） 形状（英文） 名称（中文）
rectangle 矩形（1） roundedRectangle 圆角矩形（5）
parallelogram 平行四边形（2） trapezoid 梯形 （3）
diamond 菱形（4） flowchartDecision 判定（菱形流程图）
isoscelesTriangle 等腰三角形（7） rightTriangle 直角三角形
oval 椭圆（9） circle 圆形
hexagon 六边形 octagon 八边形
pentagon 五边形 decagon 十边形
star5 五角星 star8 八角星
star16 十六角星 star24 二十四角星
cross 十字形 can 圆柱体
cube 立方体 beveledRectangle 斜角矩形
cloud 云形 lightningBolt 闪电形
arrow 箭头 leftArrow 向左箭头
rightArrow 向右箭头 upArrow 向上箭头
downArrow 向下箭头 leftRightArrow 左右双向箭头
upDownArrow 上下双向箭头 curvedRightArrow 弯曲右箭头
flowchartProcess 流程（处理） flowchartTerminator 开始/结束
flowchartData 数据 flowchartDocument 文档
flowchartPredefinedProcess 预定义流程 flowchartDelay 延迟
textbox 文本框 callout 标注框

如果我们需要在Excel中插入一个形状，需要跟上前缀msoShape，例如可以写作：

1
2
ActiveSheet.Shapes.AddShape msoShapeRectangle, 50, 50, 100, 60
ActiveSheet.Shapes.AddShape 1, 50, 50, 100, 60 ' 这里的1代表的也是长方形，是形状编号的简略写法

2）Picture 是什么？跟 Shape 有啥区别？

很多同学会在 VBA 里看到 Pictures、PictureFormat 容易混，下面我们就系统讲一下

2.1 Excel 常见的Picture相关家族

  1. Worksheet.Pictures：这是一个图片集合，但在现代 Excel 中图片也会出现在 Shapes 里，建议用 Shapes 统一管理

  2. Shape.PictureFormat： 重点！ 当 Shape 是图片时，PictureFormat 提供裁剪、亮度、对比度等能力。

你只要记住这个实战规则，工作表上的图片 = Shape（Type 通常是 msoPicture 或 msoLinkedPicture）

2.2 Addpicture方法插入图片

当然现在Excel也提供Addpictrue方法，其基本语法可以写作：

1
2
Set pictureObject = Worksheet.Shapes.AddPicture( Filename, LinkToFile, SaveWithDocument, _
    Left,Top, Width, Height )
其中参数解释如下：

  • Filename：图片文件的完整路径和文件名
  • LinkToFile：，msoTrue表示图片链接到源文件，但源文件被删除文档也受影响，因此一般msoFalse（图片嵌入文档）
  • SaveWithDocument：是否随文档保存， msoTrue：图片随文档保存， msoFalse：仅保存链接，一般用前者
  • Left,Top, Width, Height：表示的分别是左、上、宽、高，以磅为单位，如要用厘米，需要进行单位转换

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
Sub InsertPic_AddPicture()
    Dim picPath As String
    picPath = "C:\test\1.jpg"

    Dim shp As Shape
    Set shp = ActiveSheet.Shapes.AddPicture( _
        Filename:=picPath, _
        LinkToFile:=msoFalse, _
        SaveWithDocument:=msoTrue, _
        Left:=100, Top:=50, Width:=-1, Height:=-1 _
    )

    shp.Name = "Logo"
    '在这里我们可以设置 placement 属性
End Sub
Width:=-1, Height:=-1 表示按原始尺寸插入，同时在插入后，我们有了shp对象，主要包括以下三种方式，按需使用：

  • xlFreeFloating：自由浮动（不随单元格变化，这个是默认值）
  • xlMove：随单元格移动
  • xlMoveAndSize：随单元格移动并缩放（做报表模板最常用）

锁定纵横比： 我们一般按原图的大小插入，然后可以通过设置LockAspectRatio来锁定纵横比调整图片大小：

1
2
3
4
With ActiveSheet.Shapes("Logo")
    .LockAspectRatio = msoTrue
    .Width = 120
End With
但是注意很多人直接 .Width=... .Height=...，图片拉伸变形，记得先 .LockAspectRatio = msoTrue 再只改一个维度。

等比例缩放： 同样也可以通过ScaleWidth / ScaleHeight来等比例缩放图片

1
2
3
4
With ActiveSheet.Shapes("Logo")
    .ScaleWidth 0.5, msoTrue, msoScaleFromTopLeft
    .ScaleHeight 0.5, msoTrue, msoScaleFromTopLeft
End With
注意这个是以图片最开始的大小等比例缩放，同时msoScaleFromTopLeft代表的是缩放参考中心点，这个为左上角

图片裁剪： 可以通过PictureFormat来裁剪图片，裁剪的单位也是磅，这个是常用的一个方法，写法如下

1
2
3
4
5
6
7
8
Sub CropDemo()
    With ActiveSheet.Shapes("Picture 32").PictureFormat
        .CropLeft = 10
        .CropTop = 10
        .CropRight = 10
        .CropBottom = 10
    End With
End Sub

2.3 插入图片的其他几种方式

方式1：Pictures.Insert（简单但控制少），插入位置、大小不太好控，通常还要再改 Shape 属性

1
2
3
Sub InsertPic_PicturesInsert()
    ActiveSheet.Pictures.Insert("C:\test\1.jpg")
End Sub
方式2：把区域复制成图片

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
Sub RangeToPicture()
    Dim rng As Range
    Set rng = ActiveSheet.Range("A1:D10")

    ' 复制范围为图片,其中Appearance:=xlScreen 表示屏幕截图，Format:=xlPicture 表示图片格式
    rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    ActiveSheet.Paste

    ' 粘贴出来也是 Shape（或图像对象），可以从 Selection 拿
    Selection.Name = "RngShot" ' 改名后续就方便定位此对象了
End Sub

3）形状的常见操作

3.1 改名

1
ActiveSheet.Shapes("图片 1").Name = "Logo"

3.2 查找某个 shape（按名称）

1
2
Dim shp As Shape
Set shp = ActiveSheet.Shapes("Logo")

3.3 遍历所有图片并删除

1
2
3
4
5
6
7
8
Sub DeleteAllPictures()
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoPicture Or shp.Type = msoLinkedPicture Then
            shp.Delete
        End If
    Next
End Sub

3.4 批量操作：ShapeRange

这个是一个小技巧，可以通过Range接收一个arr数组，批量修改形状 

1
2
3
4
5
6
7
8
9
Sub BatchMove()
    Dim arr
    arr = Array("Logo", "RngShot")

    With ActiveSheet.Shapes.Range(arr)
        .Left = 20
        .Top = 20
    End With
End Sub

3.5 把图片“贴”到某个单元格位置

这个是做报表模板最常见需求：图片固定在某个单元格里，行高列宽变了它也跟着变。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
Sub StickPicToCell()
    Dim cell As Range
    Set cell = ActiveSheet.Range("B2")

    With ActiveSheet.Shapes("Logo")
        .Left = cell.Left
        .Top = cell.Top
        .Placement = xlMoveAndSize
    End With
End Sub

3.6 让图片适配单元格大小（保持比例）

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub FitPicInCell()
    Dim cell As Range
    Set cell = ActiveSheet.Range("B2")

    With ActiveSheet.Shapes("Logo")
        .LockAspectRatio = msoTrue
        .Placement = xlMoveAndSize

        ' 先按宽度适配
        .Left = cell.Left
        .Top = cell.Top
        .Width = cell.Width

        ' 如果高度超出，再按高度适配
        If .Height > cell.Height Then
            .Height = cell.Height
        End If

        ' 居中（可选）
        .Left = cell.Left + (cell.Width - .Width) / 2
        .Top = cell.Top + (cell.Height - .Height) / 2
    End With
End Sub

所以请记住Shapes 是总入口：图片、矩形、文本框、按钮、图表对象都在 Worksheet.Shapes 里，建议养成 插入后立刻改名的习惯，后续维护成本会低很多