大家好，我们今日继续讲解VBA代码解决方案的第118讲内容：如何把工作表中的图片导出到专门的文件。我们在工作中，有时需要将工作表中的图形对象保存为单独的图像文件，怎么操作呢？思路：首先我们用ChartObjects对象的Add 方法创建新的嵌入图表，把图片复制到这个Chart对象中，然后使用Export方法把这个图表导出来。

一：应用于ChartObjects对象的Add 方法讲解。

语法如下：expression.Add(Left, Top, Width, Height)

参数expression是必须的，返回一个ChartObjects对象。

参数Left、参数Top是必需的，以磅为单位给出新对象的初始坐标，该坐标是相对于工作表上单元格A1的左上角或图表的左上角的坐标。

参数Width、参数Height是必须的，以磅为单位给出新对象的初始大小。

二：应用于Chart对象的Export方法将图形对象以图形格式导出，语法如下：

expression.Export(Filename, FilterName, Interactive)

其中参数Filename是必须的，被导出的文件的名称。

参数FilterName是可选的,被导出的文件的图形格式,如JPG。GIF。

下面我们看我们的实际代码，如下所示。

Sub MynzExportShp()

Dim Shp As Shape

Dim FileName As String

For Each Shp In Sheets("sheet2").Shapes

If Shp.Type = msoPicture Then

FileName = ThisWorkbook.Path & "\" & Shp.Name & ".gif"

Shp.Copy

With Sheets("sheet2").ChartObjects.Add(0, 0, Shp.Width + 10, Shp.Height + 12).Chart

.Paste

.Export FileName, "gif"

.Parent.Delete

End With

End If

Next

End Sub

代码截图：

代码解析：MynzExportShp过程将Sheets("sheet2")工作表的所有图片以文件形式导出到同一目录中。

第4行代码使用For Each...Next 语句遍历Sheets("sheet2")工作表中的所有图形。

第5行代码判断图形的类型是否为图片，应用于Shape对象的Type属性返回或设置图形类型。

msoShapeTypeMixed -2 混合型图形

msoAutoShape 1 自选图形

msoCallout 2 没有边框线的标注

msoChart 3 图表

msoComment 4 批注

msoFreeform 5 任意多边形

msoGroup 6 图形组合

msoFormControl 8 窗体控件

msoLine 9 线条

msoLinkedOLEObject 10 链接式或内嵌OLE对象

msoLinkedPicture 11 剪贴画或图片

msoOLEControlObject 12 ActiveX 控件

msoPicture 13 图片

msoTextEffect 15 艺术字

msoTextBox 17 文本框

msoDiagram 21 组织结构图或其他图示

第6行代码使用字符串变量FileName记录需导出图形的路径和名称。

第7行代码复制图形，应用于Shape对象的Copy方法将对象复制到剪贴板。

第8行代码使用Add方法在工作表中添加一个图表，

第9行代码使用Paste方法将图形粘贴到新的嵌入图表中，应用于Chart对象的Paste方法将剪贴板中的图表数据粘贴到指定的图表中，语法如下：

expression.Paste(Type)

参数expression是必须的，返回一个Chart对象。

参数Type是可选的的，如果剪贴板中有图表，本参数指定要粘贴的图表信息。可为以下XlPasteType常量之一：xlFormats、xlFormulas或xlAll。默认值为xlAll，如果剪贴板中是数据不是图表，则不能使用本参数。

第10行代码使用Export方法将图表导出到同一目录中，

第10行代码删除新建的图表。因为Chart对象是不能使用Delete方法直接删除的，应先使用Parent属性返回指定对象的父对象，然后使用Delete方法删除。

运行：我现在工作表中放置两个图片，上面的是我上节做的图，下面的是我的平台图标。

运行后：

大家发现只有一个图片，为什么呢？我们下面修正代码：

Sub MynzExportShpTWO()

Dim Shp As Shape

Dim FileName As String

For Each Shp In Sheets("sheet2").Shapes

FileName = ThisWorkbook.Path & "\" & Shp.Name & ".gif"

Shp.Copy

With Sheets("sheet2").ChartObjects.Add(0, 0, Shp.Width + 28, Shp.Height + 30).Chart

.Paste

.Export FileName, "gif"

.Parent.Delete

End With

Next

End Sub

截图：

再次运行：

这样就都出来了。

今日内容回向：

1：如何在表格中导出图片？

2：上面的导出方案中为什么第一种没有导全呢？