Excel 2010 VBA 入门 105 将工作表数据批量导出为图片

目录

示例    

代码

Copy. Cut和Paste方法

图表对象(Chart)的Export方法

利用PPT导出图片

---

示例    

为防止数据的更改或者盗用，将所选的数据区域导出为图片进行展示。

代码

    在Excel中，仅为图表(Chart)提供了一个导出图片的方法，因而使用该方法可以将指定的图片导出。创建一个空白的图表容器对象( ChartObject)，将所需要导出的对象使用CopyPicture方法复制，依次执行图表对象子对象Chart的Paste（粘贴）和Export（导出为图片）方法，最后删除该图表对象即可。

Option Explicit

Sub 导出图片()
    Dim objCht As ChartObject
    
    '操作选中的区域
    With Selection
        '复制为图片
        .CopyPicture
        创建一个尺寸和区域大小相同的图表对象
        Set objCht = ActiveSheet.ChartObjects.Add(0, 0, .Width, .Height)
    End With
    
    '操作图表
    With objCht.Chart
        .Paste
        .Export ThisWorkbook.Path & "\图片.jpg"
        .Parent.Delete
    End With
End Sub

Copy. Cut和Paste方法

    在Excel中，几乎所有的对象都具有Copy（复制）、Cut（剪切）和Paste（粘贴）方法。执行Copy或者Cut方法后，可以将该对象复制或剪切到Office剪贴板，然后使用Paste方法可以将Office剪贴板中的内容粘贴至指定位置。
对于图像的复制，也可以使用CopyPicture方法，其语法为

Object.CopyPicture(Appearance,Format)

其中，Object为一个对象，可以为单元格区域、Shape、Chart等。
  参数Appearance为图表复制的方式，可以为xIPrinter（按打印效果复制）或者xIScreen（按当前显示的效果复制）。
  参数Format为图片的格式，可以为xIBitmap（位图，如BMP、JPG等）或者xIPicture（图元，如png、vrmf等）。
  本例中，由于需要对单元格进行图片的导出，若直接使用Copy方法，然后在图表中使用Paste，则Excel会将该区域作为数据源添加入图表中。为避免该错误，首先对需要进行图片导出的单元格执行CopyPicture方法强制复制成图片到剪贴板，然后执行图表对象的Paste方法，即可实现将图片复制到图表中，从而进行下一步操作。

图表对象(Chart)的Export方法

使用Chart对象的Export方法可以将图表导出为图片，并保存至指定的目录中，其语法

Chart.Export(Filename[,FilterName]

其中，Chart表示一个图表( Chart)对象。

参数Filename为文件的完整路径，包括路径、文件名及扩展名。
参数FilterName表示文件的类型，一般和扩展名相同。若不设置该参数，则文件保存类型以Filename中所设置的扩展名为准。当指定目录下已经存在同名文件时，使用该方法导出图片会覆盖原文件。

利用PPT导出图片

在PPT中，可以直接使用Export方法将图形导出为图片并存在指定的路径下，其语法为

Shape.Export PathName,Filter,ScaleWidth,ScaleHeight,ExportMode

其中，Shape为PPT中的一个图形对象。

• 参数PathName表示输出文件的完整路径及名称。
• 参数Filter为文件的类型，可以为0至5的整数，分别代表GIF、JPG、PNG、BMP、WMF和EMF格式的文件。
• 参数ScaleWidth、ScaleHeight可省略，其为长整型表达式，表示图形的缩放。
• 参数ExportMode为输出的模式。

    当使用该方法导出图片时，必须首先创建一个PPT程序对象，然后创建一个PPT文件并添加一张幻灯片。复制的图片需要粘贴在该幻灯片中，然后使用Export方法导出。其参考代码
如下：
 

Option Explicit

Public Sub 使用PPT导出图片()
    Dim pptApp As Object
    Dim pptObj As Object
    Dim pptSlide As Object
    Dim pptShape As Object
    
    Selection.CopyPicture
    Set pptApp = CreateObject("PowerPoint.Application")
    Set pptObj = pptApp.presentations.Add
    Set pptSlide = pptObj.slides.Add(1, 12)
    Set pptShape = pptSlide.Shapes.Paste
    pptShape.Export ThisWorkbook.Path & "\图片.jpg", 1
    
    pptObj.Saved = True
    pptObj.Close
    pptApp.Quit
    
End Sub