一篇文章带你玩转VBA中的形状操作（含代码演示）
文章目录
- 1）Shapes / Shape 到底是什么关系？
- 2）Picture 是什么？跟 Shape 有啥区别？
- 2.1 Excel 常见的Picture相关家族
- 2.2 Addpicture方法插入图片
- 2.3 插入图片的其他几种方式
- 3）形状的常见操作
- 3.1 改名
- 3.2 查找某个 shape（按名称）
- 3.3 遍历所有图片并删除
- 3.4 批量操作：ShapeRange
- 3.5 把图片“贴”到某个单元格位置
- 3.6 让图片适配单元格大小（保持比例）
1）Shapes / Shape 到底是什么关系？
在 Excel VBA 里，图形体系基本是这样：
Worksheet.Shapes：一个集合（集合里装着所有 Shape）Shape：集合里的单个图形对象（矩形、文本框、图片、按钮、图表对象……都算 Shape）
结论一句话：在 Excel 里，“图片”本质上也是 Shape，只是 Shape 的类型不同。典型代码如下：
' 此代码用于打印活动工作表中的所有形状和具体类型编号 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，例如可以写作：
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相关家族
Worksheet.Pictures：这是一个图片集合，但在现代 Excel 中图片也会出现在Shapes里，建议用Shapes统一管理Shape.PictureFormat：重点！当Shape是图片时，PictureFormat提供裁剪、亮度、对比度等能力。
你只要记住这个实战规则，工作表上的图片 =Shape（Type 通常是msoPicture或msoLinkedPicture）
2.2 Addpicture方法插入图片
当然现在Excel也提供Addpictrue方法，其基本语法可以写作：
Set pictureObject = Worksheet.Shapes.AddPicture( Filename, LinkToFile, SaveWithDocument, _ Left,Top, Width, Height )其中参数解释如下：
Filename：图片文件的完整路径和文件名LinkToFile：，msoTrue表示图片链接到源文件，但源文件被删除文档也受影响，因此一般msoFalse（图片嵌入文档）SaveWithDocument：是否随文档保存，msoTrue：图片随文档保存，msoFalse：仅保存链接，一般用前者Left,Top, Width, Height：表示的分别是左、上、宽、高，以磅为单位，如要用厘米，需要进行单位转换
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 SubWidth:=-1, Height:=-1表示按原始尺寸插入，同时在插入后，我们有了shp对象，主要包括以下三种方式，按需使用：
xlFreeFloating：自由浮动（不随单元格变化，这个是默认值）xlMove：随单元格移动xlMoveAndSize：随单元格移动并缩放（做报表模板最常用）
锁定纵横比：我们一般按原图的大小插入，然后可以通过设置LockAspectRatio来锁定纵横比调整图片大小：
With ActiveSheet.Shapes("Logo") .LockAspectRatio = msoTrue .Width = 120 End With但是注意很多人直接.Width=....Height=...，图片拉伸变形，记得先.LockAspectRatio = msoTrue再只改一个维度。
等比例缩放：同样也可以通过ScaleWidth / ScaleHeight来等比例缩放图片
With ActiveSheet.Shapes("Logo") .ScaleWidth 0.5, msoTrue, msoScaleFromTopLeft .ScaleHeight 0.5, msoTrue, msoScaleFromTopLeft End With注意这个是以图片最开始的大小等比例缩放，同时msoScaleFromTopLeft代表的是缩放参考中心点，这个为左上角
图片裁剪：可以通过PictureFormat来裁剪图片，裁剪的单位也是磅，这个是常用的一个方法，写法如下
Sub CropDemo() With ActiveSheet.Shapes("Picture 32").PictureFormat .CropLeft = 10 .CropTop = 10 .CropRight = 10 .CropBottom = 10 End With End Sub2.3 插入图片的其他几种方式
方式1：Pictures.Insert（简单但控制少），插入位置、大小不太好控，通常还要再改 Shape 属性
Sub InsertPic_PicturesInsert() ActiveSheet.Pictures.Insert("C:\test\1.jpg") End Sub方式2：把区域复制成图片
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 Sub3）形状的常见操作
3.1 改名
ActiveSheet.Shapes("图片 1").Name = "Logo"3.2 查找某个 shape（按名称）
Dim shp As Shape Set shp = ActiveSheet.Shapes("Logo")3.3 遍历所有图片并删除
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 Sub3.4 批量操作：ShapeRange
这个是一个小技巧，可以通过Range接收一个arr数组，批量修改形状
Sub BatchMove() Dim arr arr = Array("Logo", "RngShot") With ActiveSheet.Shapes.Range(arr) .Left = 20 .Top = 20 End With End Sub3.5 把图片“贴”到某个单元格位置
这个是做报表模板最常见需求：图片固定在某个单元格里，行高列宽变了它也跟着变。
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 Sub3.6 让图片适配单元格大小（保持比例）
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里，建议养成插入后立刻改名的习惯，后续维护成本会低很多，后续也会继续分享更多VBA编程的相关内容，我是不懂代码的杰瑞学长，我们下期再见！
如果觉得文章对你有帮助，欢迎点赞 + 收藏 + 关注，一起进步！