批量导出Excel图形和图片对象-今日头条

嗨，大家好。还记得上一期我们将外部的图片批量地导入到Excel工作表单元格区域码？我们当时用的是关键的核心语句“工作表.Pictures.Insert (含图片的全路径)”实现的哦，如果已经忘记了，可以进入头条回过去看看哦。

而这一期我们要弄个什么作品呢？我们这一期准备弄一个将导入的图片反向地批量导出，并且可以实现随时删除已经导出的图片文件。听起来，还是挺兴奋的，但是，实现起来还是比较具体的哦。比如说，导出图片方面：要探测需要删除图片的文件夹路径是否存在？即使存在，是否该路径以及失效？没有失效的情况下，该路径下是否有图片文件……等等之类的。而删除外部导出的图片同样有类似的问题等等。

对于这些问题，我们都要仔细斟酌与考虑，用精细的思维方法去解决，否则做出的作品应用将是残缺的甚至是漏洞百出的。这些都不是我们想要的。鉴于这些情况，我们必须开发设计一个较为完美的应用。历时近乎一天的设计，终于几乎是大功告成了。

现在，我就来分享下自己的设计过程吧！不要忘记了，这次同样是以纯干货的形式分享给大家哦！

一、批量导出/删除图片文件的Excel界面设计

插入4张图片和1个自选绘制图形，再插入两个表单控件按钮。设置这两个按钮的显示文字为“批量导出本Excel工作表上的图形、图片对象”和“删除批量导出到外部文件夹的图形、图片文件”（内部部份文字颜色为了蓝色、红色），名称分别为“导出图形图片按钮”和“删除批量导出到外部文件夹的图形、图片文件”。如下图所示

图1 导出/删除图片文件界面

二、导出/删除批量图片文件的功能代码设计

模块1代码如下：

Public sPath As String '定义一个公有的全局导出图片的全路径变量sPath用于全局路径调用

Public Function FileFolderExists(strFullPath As String) As Boolean '自定义文件/文件夹是否存在判断函 _

数FileFolderExists() 如果指定的文件夹或文件存在，FileFolderExists返回True

On Error GoTo EarlyExit

'如果用内置函数Dir()判定文件/文件夹存在的逻辑情 _

况求反为vbNullString的话（即文件/文件夹存在） _

，则返回逻辑值True。关于dir函数，请参考百度云 _

盘链接：https://pan.baidu.com/s/1dSq9i4dnagsLKYRGs4tOMQ 密码：twge _

目录函数Dir(pathname[, attributes]) 其中pathname参 _

数是路径名，attributes参数是属性(属性参数可选！)

If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True

EarlyExit:

On Error GoTo 0

End Function

Sub Export_Batch_Pic() '批量导出Excel工作表上的图形、图片对象到外部指导的文件夹

'定义工作表对象变量sht、图表对象变量cht、图形对象变量shp、图片图形名称数组shp_name_arr()、对话框 _

文件名变量FileName、第一个图片图形名称变量shp_first_name、临时文件名变量tmpFileName(用于存储将原 _

有对话框选择的原始文件名作特殊处理后的结果)

Dim sht As Worksheet, cht As ChartObject, shp As Shape, shp_name_arr(200) As String, FileName As _

String, shp_first_name As String, tmpFileName As String

Set sht = Sheets("Sheet1")

k = 0 'k为图形名称数组shp_name_arr()的下标计数器

For Each shp In sht.Shapes

If shp.Name <> "导出图形图片按钮" And shp.Name <> "删除导出到外部图片文件按钮" Then

shp_name_arr(k) = shp.Name

k = k + 1

End If

shp_first_name = shp_name_arr(0)

MsgBox "即将需要导出" & k & "个图片图形到外部！", vbInformation, "提示"

FileName = Application.GetSaveAsFilename(InitialFileName:=shp_first_name & ".jpg" _

, FileFilter:="JPEG文件(*.jpg),*.jpg", Title:="导出文件") '指定将另存为文件 _

的名字定为默认图形名称shp.Name，文件类型过滤器强制指定为“JPEG文件(*.jpg),*.jpg” _

类型，并将另存为文件对话框的标题更改为“指定文件名"

If FileName = "False" Then '如果点击了“导出文件”对话框的“取消”按钮或对话 _

框标题栏的“X”按钮，则退出

MsgBox "未作任何导出图片操作，退出！", vbInformation, "提示"

GoTo Exit_Line

Else '否则执行了文件另存为对话框“导出文件”的“保存”按钮，则导出图片

'由于FileFolderExists(strFullPath)函数的参数strFullPath是代表全路径，且 _

遵行目录分割符是“/”而非“\”，所以用一个临时文件名变量tmpFileName保存替 _

换过的文件路径

tmpFileName = Replace(FileName, "\", "/")

If FileFolderExists(tmpFileName) Then

If MsgBox("有同名文件，是否替换或覆盖？", vbQuestion + vbYesNo, "提示") = vbYes Then

'导出为图片文件

sPath = Left(FileName, Len(FileName) - Len(shp_first_name) - 4)

For Each shp In sht.Shapes

If shp.Name <> "导出图形图片按钮" And shp.Name <> "删除导出到外部图片文件按钮" Then

shp.CopyPicture Appearance:=xlScreen, Format:=xlPicture '复制到剪贴板（呈现方式Appearance _

是以屏幕显示xlScreen复制的方式，格式Format是普通图片xlPicture的格式）

Set cht = Sheets(2).ChartObjects.Add(0, 0, shp.Width, shp.Height) '临时图表对象生成（以 _

(Left:0,Top:0)位置，宽、高分别为上面的图形对象shp的宽shp.Width高shp.Height为参数进行动 _

态添加临时图表对象）并指定给予图表对象变量cht

cht.Chart.Paste 'cht图表对象将将剪切板中的对象粘贴出来, 下面语句则是将其导出为图片文件

cht.Chart.Export FileName:=sPath & shp.Name & ".JPG", FilterName:=UCase(Right(FileName, 3))

cht.Delete '删除临时的图表对象cht(释放对象的善后操作)

End If

Sheets(2).Cells(65535, 1) = sPath

MsgBox "导出图片替换源文件成功！", vbInformation, "提示"

Else

MsgBox "未作任何导出图片操作，退出！", vbInformation, "提示"

GoTo Exit_Line

End If

Else

'导出为图片文件

sPath = Left(FileName, Len(FileName) - Len(shp_first_name) - 4)

For Each shp In sht.Shapes

If shp.Name <> "导出图形图片按钮" And shp.Name <> "删除导出到外部图片文件按钮" Then

shp.CopyPicture Appearance:=xlScreen, Format:=xlPicture '复制到剪贴板（呈现方式Appearance是 _

以屏幕显示xlScreen复制的方式，格式Format是普通图片xlPicture的格式）

Set cht = Sheets(2).ChartObjects.Add(0, 0, shp.Width, shp.Height) '临时图表对象生成（以( _

Left:0,Top:0)位置，宽、高分别为上面的图形对象shp的宽shp.Width高shp.Height为参数进行动态添加 _

临时图表对象）并指定给予图表对象变量cht

cht.Chart.Paste 'cht图表对象将将剪切板中的对象粘贴出来, 下面语句则是将其导出为图片文件

cht.Chart.Export FileName:=sPath & shp.Name & ".JPG", FilterName:=UCase(Right(FileName, 3))

cht.Delete '删除临时的图表对象cht(释放对象的善后操作)

End If

Sheets(2).Cells(65535, 1) = sPath '将变量中已获取的全路径保存到Sheets(2)工作表单元格Cells(65535,1) _

中去

MsgBox "导出图片成功！", vbInformation, "提示"

End If

Exit_Line:

End Sub

Sub Delete_Batch_Pics_Exported() '批量删除导出到外部的图片文件

Set fs = CreateObject("Scripting.FileSystemObject") '构建一个文件系统对象fs

'通过下面方式重新获取不带文件名的路径

sPath = Sheets(2).Cells(65535, 1) '回传Sheets(2)工作表单元格Cells(65535,1)保存的路径信息到公有全局 _

全路径sPath变量中去

If Len(sPath) = 0 Then '若路径对象变量长度为空(即路径为空)，则作如下判断处理

MsgBox "批量导出图片的文件夹路径不存在!" & Chr(10) & "有可能您根本未导出过图片！" & Chr(10) & "请仔细看看什么情况再操作！", vbInformation, "提示"

Exit Sub

Else '否则，路径非空，则又作下面新的判断处理

Existed_Folder = Dir(sPath, vbDirectory) '用目录存在测试函数Dir()获取指定的路径目录存在情况

If Existed_Folder = "" Then '如果为空(即该指定的目录不存在)，则禁止任何无效的操作

prompt_str_head = "该文件夹路径【" & sPath & "】"

prompt_str_tail = "是一个失效的路径!不允许任何操作！"

MsgBox prompt_str_head & Chr(10) & Space((Len(prompt_str_head) - Len(prompt_str_tail)) / 2) & prompt_str_tail, vbInformation, "提示"

Exit Sub

Else '否则非空(即该指定的目录存在)，则作如下有效的操作

Set myfolder = fs.GetFolder(sPath) '构建并指派文件夹对象实例传递给文件夹对象变量myfolder

Set myfiles = myfolder.Files '构建并指派该文件夹下系列文件对象实例传递给文件集合对象变量myfiles

files_num = 0 '用于统计该文件夹下所有图片文件的个数

For Each myfile In myfiles '对于临时的文件对象在该文件集合中是，统计该文件夹下所有图片文件的个数

'重新更改文件名

mc = myfile.Name

If InStr(UCase(mc), ".JPG") Or InStr(UCase(mc), ".JPEG") Then

files_num = files_num + 1

End If

If files_num = 0 Then '若该文件夹下文件数量为0(即该文件夹是一个空文件夹)

prompt_str_head = "该文件夹路径【" & sPath & "】下无任何图片文件!"

prompt_str_tail = "删除操作被禁止！"

MsgBox prompt_str_head & Chr(10) & Space((Len(prompt_str_head) - Len(prompt_str_tail)) / 2) & prompt_str_tail, vbInformation, "提示"

Exit Sub

Else '否则该文件夹图片文件个数非0，则遍历这些图片文件并即刻删除

For Each myfile In myfiles

'重新更改文件名

mc = myfile.Name

If InStr(UCase(mc), ".JPG") Or InStr(UCase(mc), ".JPEG") Or InStr(UCase(mc), ".DB") Then

myfile.Delete

End If

prompt_str_head = "删除导出到该文件夹【" & sPath & "】下的"

prompt_str_tail = "[" & files_num & "]个图片文件成功!自己去看看删除成功没有吧！"

MsgBox prompt_str_head & Chr(10) & Space((Len(prompt_str_head) - Len(prompt_str_tail)) / 2) & prompt_str_tail, vbInformation, "提示"

End If

End Sub

三、为图1界面的表单按钮分别指定运行宏

为导出图片指定运行宏“Export_Batch_Pic”，为删除批量图片按钮指定运行宏“Delete_Batch_Pics_Exported”。界面截图如下所示

图2 为导出/删除图片按钮指定运行宏

四、测试批量导出/删除图片文件应用设计效果

(一)点击表单按钮<批量导出本Excel工作表上的图形、图片对象>：弹出提示“即将需要导出5个图片图形到外部！”。如下图所示

图3 显示即将删除5个图片文件的提示

(二)点击<确定>后，弹出导出文件目录路径选择对话框，选择相应路径。如下图所示

图4 弹出导出图片文件路径选择对话框

(三)在上面对话框中选择路径后点击<打开>按钮后的情况。如下图所示

图5 选择打开按钮后的结果

(四)点击<保存>按钮，完成批量图片导出为文件的操作。如下图所示

图6 导出图片成功的提示

(五)打开刚才导出的文件夹目录，查看是否已经导出成功的图片。如下图所示

图7 导出成功的图片文件展示

(六)批量删除导出到外部文件夹下导出的图片文件：点击表单控件按钮<删除批量导出到外部文件夹的图形、图片文件>，会弹出删除文外部导出的文件成功的提示。如下图所示

图8 删除导出到外部的图片文件成功提示

(七)打开被删除图片的文件夹路径，查证是否真的删除成功。界面截图如下所示

图9 查证是否真正删除了导出到外部的图片文件

测试的补充说明：各种异常情况的操作，例如，取消了导出为外部图片文件的操作，删除图片文件时，是否该文件夹路径是空文件夹以及该文件夹下是否有图片文件等这些操作，大家可以根据我分享的代码设计成功后自行测试事实。在这里，我们举不截图了，如果实在好看，可以看看我的视频作品展示哦！

五、必要的关键技术小结

(一)导出excel工作表上的图片到外部的图片文件方法：(1)将图形进行图片式的复制“shp.CopyPicture Appearance:=xlScreen, Format:=xlPicture”；(2)创建一个图表对象“Set cht = Sheets(2).ChartObjects.Add(0, 0, shp.Width, shp.Height)”；(3)在图表对象上实施粘贴操作(将剪切板里上的图片粘贴进图表对象内部)“cht.Chart.Paste”；(4)将图表对象(此时，已携带图片了)整体导出到外部指定路径的文件夹下去“cht.Chart.Export FileName:=sPath & shp.Name & ".JPG", FilterName:=UCase(Right(FileName, 3))”。

(二)利用选择保存文件选择路径的对话框形式更为灵活地选择路径：(1) FileName = Application.GetSaveAsFilename(InitialFileName:=shp_first_name & ".jpg", FileFilter:="JPEG文件(*.jpg),*.jpg", Title:="导出文件")；(2) sPath = Left(FileName, Len(FileName) - Len(shp_first_name) - 4)

(三)判别指定的文件夹路径是否存在的机制：判断Dir(sPath, vbDirectory)是否为空可以得知指定的路径是否存在

好了，本期作品干货的头条文章就分享到这里吧。希望能够给大家带来帮助哦！

最后，还是非常感谢给为朋友的关注(头条号：跟我学office高级办公)，推广和点评哦，愿大家每天都有好心情！

批量导出Excel图形和图片对象

头条热榜

精彩视频