通过VBA将word文档导出为图片，每个页面一张图片

应用场景：

        在工作中，有时候需要把WORD文档截图发到工作群。一是比直接发文档好，点开就能看；二是比直接发文字好，直接复制文字到聊天窗口就清除掉了格式。

        直接截图大小不一，而且带有换行标记，如下图。

        我有时习惯进到打印预览页面，再截图。但是当页面很多时，就比较麻烦。 

思路：

        把当前文档保存为PDF——》PDF通过acrobat导出为JPEG——》删除PDF。

主要代码：

        通过网上学习，借鉴了导出PDF为图片的VBA代码。其他代码自己实验。代码如下，需要的自取：

Sub SavePDFAs(PDFPath As String)
    '此函数主要是借鉴来的，主要作用是把PDF转成图片，和PDF在同一个路径下面。
    '要安装了acrobat才能使用
    Dim objAcroApp      As Acrobat.AcroApp
    Dim objAcroAVDoc    As Acrobat.AcroAVDoc
    Dim objAcroPDDoc    As Acrobat.AcroPDDoc
    Dim objJSO          As Object
    Dim boResult        As Boolean
    Dim ExportFormat    As String
    Dim NewFilePath     As String
    '初始化 Acrobat
    Set objAcroApp = CreateObject("AcroExch.App")
    '设置 AVDoc
    Set objAcroAVDoc = CreateObject("AcroExch.AVDoc")
    '打开 the PDF
    boResult = objAcroAVDoc.Open(PDFPath, "")
    '设置 PDDoc
    Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
    '设置 JS Object - Java Script Object.
    Set objJSO = objAcroPDDoc.GetJSObject
    '导出类型
    ExportFormat = "com.adobe.acrobat.jpeg"
    '导出文件位置
    NewFilePath = WorksheetFunction.Substitute(PDFPath, ".pdf", ".jpeg")
    '导出操作
    boResult = objJSO.SaveAs(NewFilePath, ExportFormat)
    '关闭，不保存修改
    boResult = objAcroAVDoc.Close(True)
    '关闭
    boResult = objAcroApp.Exit
End Sub
Sub word_to_jpeg()
    '1.判断是否已保存
    If ActiveDocument.Path = "" Then
        MsgBox ("请先保存该文档，再试！"): Exit Sub
    End If
    '2.在当前目录生成一个文件夹，如果重名，则加上时间序号
    '先获取文件名，去扩展名,作为新的文件夹名称
    docName = Left(ActiveDocument.Name, InStrRev(ActiveDocument.Name, ".") - 1)
    foldername = ActiveDocument.Path & "\" & docName
    If Dir(foldername, vbDirectory) <> "" Then foldername = foldername & "_" & Format(Now(), "yyMMddHHmmss")
    MkDir foldername
    '3.把文档另存为pdf，到这个文件夹
    pdffilePath = foldername & "\" & docName & ".pdf" '指定PDF文件路径和名称
    ActiveDocument.ExportAsFixedFormat OutputFileName:=pdffilePath, ExportFormat:= _
    wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
    wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
    Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
    CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
    BitmapMissingFonts:=True, UseISO19005_1:=False
    '4.把这个PDF文件导出为图片
    SavePDFAs (pdffilePath)
    '5.删除这个pdf文件
    Kill pdffilePath
    '6.打开图片所在的文件夹
    Shell "explorer.exe " & foldername, vbNormalFocus
End Sub