文章目录1Shapes / Shape 到底是什么关系2Picture 是什么跟 Shape 有啥区别2.1 Excel 常见的Picture相关家族2.2 Addpicture方法插入图片2.3 插入图片的其他几种方式3形状的常见操作3.1 改名3.2 查找某个 shape按名称3.3 遍历所有图片并删除3.4 批量操作ShapeRange3.5 把图片“贴”到某个单元格位置3.6 让图片适配单元格大小保持比例1Shapes / Shape 到底是什么关系在 Excel VBA 里图形体系基本是这样Worksheet.Shapes一个集合集合里装着所有 ShapeShape集合里的单个图形对象矩形、文本框、图片、按钮、图表对象……都算 Shape结论一句话在 Excel 里“图片”本质上也是 Shape只是 Shape 的类型不同。典型代码如下 此代码用于打印活动工作表中的所有形状和具体类型编号 Dim shp As Shape For Each shp In ActiveSheet.Shapes Debug.Print shp.Name, shp.Type Next对于所有的形状我这里整理了一张速查表可以对照参考带了数字的是编号简写形状英文名称中文形状英文名称中文rectangle矩形1roundedRectangle圆角矩形5parallelogram平行四边形2trapezoid梯形 3diamond菱形4flowchartDecision判定菱形流程图isoscelesTriangle等腰三角形7rightTriangle直角三角形oval椭圆9circle圆形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代表的也是长方形是形状编号的简略写法2Picture 是什么跟 Shape 有啥区别很多同学会在 VBA 里看到Pictures、PictureFormat容易混下面我们就系统讲一下2.1 Excel 常见的Picture相关家族Worksheet.Pictures这是一个图片集合但在现代 Excel 中图片也会出现在Shapes里建议用Shapes统一管理Shape.PictureFormat重点当Shape是图片时PictureFormat提供裁剪、亮度、对比度等能力。你只要记住这个实战规则工作表上的图片 ShapeType 通常是msoPicture或msoLinkedPicture2.2 Addpicture方法插入图片当然现在Excel也提供Addpictrue方法其基本语法可以写作Set pictureObject Worksheet.Shapes.AddPicture( Filename, LinkToFile, SaveWithDocument, _ Left,Top, Width, Height )其中参数解释如下Filename图片文件的完整路径和文件名LinkToFilemsoTrue表示图片链接到源文件但源文件被删除文档也受影响因此一般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 插入图片的其他几种方式方式1Pictures.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 Logo3.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编程的相关内容我是不懂代码的杰瑞学长我们下期再见如果觉得文章对你有帮助欢迎点赞 收藏 关注一起进步