通过VBA将word文档导出为图片，每个页面一张图片 |
您所在的位置：网站首页 › word导出指定页面 › 通过VBA将word文档导出为图片，每个页面一张图片 |
通过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
|
【本文地址】
今日新闻 |
推荐新闻 |