Excel | VBA(12)—批量导出图片并重命名

一起来学office，提高办公技能

问题情境

一位粉丝朋友问了一个问题：

如何将工作表的图片批量导出，并重命名为某列对应行的内容？

比如下图：

要将工作表中的图片批量导出，并且重新命名为B列对应的名称。

VBA实现

在VBA代码窗口中输入如下代码：

Sub Rename() Application.ScreenUpdating = False On Error Resume Next MkDir ThisWorkbook.Path & "\图片" For Each pic In Shapes If pic.Type = msoPicture Then RN = pic.TopLeftCell.Offset(0, -3).Value '重命名图片 pic.Copy With ActiveSheet.ChartObjects.Add(0, 0, pic.Width, pic.Height).Chart '创建图片 .Parent.Select .Paste .Export ThisWorkbook.Path & "\图片\" & RN & ".jpg" .Parent.Delete End With End If Next MsgBox "导出图片完成！" Application.ScreenUpdating = TrueEnd Sub

如下图：

在工作表中添加表单控件，右键指定宏Rename，如下两图：

点击控件，即可实现在该EXCEL文档所在的文件夹中新建一个“图片”文件夹，所以导出的图片实现重命名并保存在该“图片”文件夹中。如下图：

如果不知道控件怎么插入，怎么指定宏，请参考Excel | 让“宏”来替你做重复动作。

---------------------

有关VBA：

Excel | VBA(11)—合并个人简历到统一工作表

Excel | VBA(10)—聚光灯效果（阅读模式）设置

Excel | VBA(9)—与所选单元格相同的行自动添加颜色，核查数据如此方便

Excel | VBA(8)——工作表输入数据自动加边框，删除数据自动去除边框

Excel | VBA（7）--根据订单号跨多工作表查询数据

Excel | VBA(6)——一对多查询，几行代码代替复杂公式