[英]Excel to Word to PDF using VBA
Background : With help from StackOverflow, I have successfully found a way to copy specific content (Text, Tables and Charts) from Excel to a Word template with bookmarks using VBA.背景:在 StackOverflow 的帮助下,我成功地找到了一种将 Excel 中的特定内容(文本、表格和图表)复制到使用 VBA 的带有书签的 Word 模板的方法。 While saving this, I don't want a.docx format, but instead, want to export it to.pdf.
保存时,我不想要 .docx 格式,而是想将其导出为 .pdf。 I tried used the ExportAsFixedFormat and ExportAsFixedFormat2 and was able to export it successfully.
我尝试使用 ExportAsFixedFormat 和 ExportAsFixedFormat2 并且能够成功导出它。
Issue : The content on this.pdf file is exported as an image (I guess).问题:this.pdf 文件中的内容导出为图像(我猜)。 I am unable to highlight or copy text from the file.
我无法突出显示或复制文件中的文本。 What am I doing wrong and how can I fix this?
我做错了什么,我该如何解决? (FYI, Content Copying is set to 'Allowed' on the pdf)
(仅供参考,pdf 上的内容复制设置为“允许”)
I am currently using ActiveDocument.ExportAsFixedFormat2 SaveName, wdExportFormatPDF, , wdExportOptimizeForPrint
and have tried other variables too.我目前正在使用
ActiveDocument.ExportAsFixedFormat2 SaveName, wdExportFormatPDF, , wdExportOptimizeForPrint
并且也尝试了其他变量。
Any help will be greatly appreciated.任何帮助将不胜感激。
Code:代码:
Option Explicit
Sub ExportFile()
Dim wrdApp As Word.Application
Dim WrdDoc As Word.Document
Dim WrdRng As Word.Range
Dim WrdShp As Word.InlineShape
Dim SaveName As String
Dim ChrObj As ChartObject
Set wrdApp = New Word.Application
'wrdApp.Visible = True
'wrdApp.Activate
With wrdApp
.Documents.Add Environ("UserProfile") & "\Desktop\Template.dotx"
With .Selection
Range("XEX771").Copy
.GoTo What:=-1, Name:="Bookmark1"
.PasteSpecial xlPasteValues
.GoTo What:=-1, Name:="Bookmark2"
Range("AG696", Range("AG696").End(xlDown).End(xlToRight)).Copy
Application.Wait Now() + #12:00:02 AM#
.PasteExcelTable True, False, False
.GoTo What:=-1, Name:="Bookmark3"
Range("F26", Range("F26").End(xlDown).End(xlToRight)).Copy
Application.Wait Now() + #12:00:02 AM#
.PasteExcelTable True, False, False
.GoTo What:=-1, Name:="Bookmark4"
Range("XEO5").Copy
.PasteSpecial xlPasteValues
.GoTo What:=-1, Name:="Bookmark5"
Range("K26", Range("K26").End(xlDown).End(xlToRight)).Copy
Application.Wait Now() + #12:00:02 AM#
.PasteExcelTable True, False, False
End With
Set ChrObj = ActiveSheet.ChartObjects(1)
ChrObj.Chart.ChartArea.Copy
Application.Wait Now() + #12:00:02 AM#
.Selection.GoTo What:=-1, Name:="Bookmark6"
.Selection.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdInLine
Set ChrObj = ActiveSheet.ChartObjects(2)
ChrObj.Chart.ChartArea.Copy
Application.Wait Now() + #12:00:02 AM#
.Selection.GoTo What:=-1, Name:="Bookmark7"
.Selection.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdInLine
Set ChrObj = ActiveSheet.ChartObjects(3)
ChrObj.Chart.ChartArea.Copy
Application.Wait Now() + #12:00:02 AM#
.Selection.GoTo What:=-1, Name:="Bookmark8"
.Selection.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdInLine
SaveName = Environ("UserProfile") & "\Desktop\FileName.pdf"
.ActiveDocument.ExportAsFixedFormat2 SaveName, wdExportFormatPDF, , wdExportOptimizeForPrint
End With
wrdApp.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
wrdApp.Quit
Set wrdApp = Nothing
End Sub
Using Selection is very inefficient - which may also help explain why you've inserted so many delays in your code.使用 Selection 效率非常低 - 这也可能有助于解释为什么您在代码中插入了如此多的延迟。 You also have numerous unnecessary.Goto and copy/paste operations.
您还有许多不必要的。转到和复制/粘贴操作。 Try:
尝试:
Sub ExportFile()
Dim wrdApp As New Word.Application, WrdDoc As Word.Document
Dim WrdRng As Word.Range, WrdShp As Word.InlineShape
Dim xlSheet As Excel.Worksheet: Set xlSheet = ActiveSheet
With wrdApp
.Visible = False
Set WrdDoc = .Documents.Add(Environ("UserProfile") & "\Desktop\Template.dotx")
With WrdDoc
.Bookmarks("Bookmark1").Range.Text = xlSheet.Range("XEX771").Text
xlSheet.Range("AG696", Range("AG696").End(xlDown).End(xlToRight)).Copy
.Bookmarks("Bookmark2").Range.PasteExcelTable True, False, False
xlSheet.Range("F26", Range("F26").End(xlDown).End(xlToRight)).Copy
.Bookmarks("Bookmark3").Range.PasteExcelTable True, False, False
.Bookmarks("Bookmark4").Range.Text = xlSheet.Range("XEO5").Text
xlSheet.Range("K26", Range("K26").End(xlDown).End(xlToRight)).Copy
.Bookmarks("Bookmark5").Range.PasteExcelTable True, False, False
xlSheet.ChartObjects(1).Chart.ChartArea.Copy
.Bookmarks("Bookmark6").Range.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdInLine
xlSheet.ChartObjects(2).Chart.ChartArea.Copy
.Bookmarks("Bookmark7").Range.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdInLine
xlSheet.ChartObjects(3).Chart.ChartArea.Copy
.Bookmarks("Bookmark8").Range.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdInLine
.SaveAs FileName:=Environ("UserProfile") & "\Desktop\FileName.pdf", _
FileFormat:=wdFormatPDF, AddToRecentFiles:=False
.Close False
End With
.Quit
End With
Set WrdDoc = Nothing: Set wrdApp = Nothing: Set xlSheet = Nothing
End Sub
This was a problem with the "Bitmap text when fonts may not be embedded" option while saving PDF files via MS Word.这是通过 MS Word 保存 PDF 文件时“可能未嵌入 fonts 时的位图文本”选项的问题。 I referred to this page and added BitmapMissingFonts:=False.
我参考了这个页面并添加了 BitmapMissingFonts:=False。 Resolved the issue.
解决了这个问题。
.ActiveDocument.ExportAsFixedFormat2 SaveName, wdExportFormatPDF, BitmapMissingFonts:=False
Thanks, everyone!感谢大家!
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.