使用 VBA 将 Excel 范围复制到 Word 文件时出现问题

Question

我查看了一些有关如何从 Excel 复制范围并粘贴到 Word 文档的 VBA 代码，但我无法使用它，它会创建一个 pdf 文件，但文件已损坏。

我有以下 VBA 代码：

    Sub CopyToWordAndPrintPDF()
    'PURPOSE: Copy/Paste An Excel Table Into a New Word Document
    'NOTE: Must have Word Object Library Active in Order to Run _
  (VBE > Tools > References > Microsoft Word 1x.0 Object Library)
      
    'Name of the existing Word document
    Const stWordDocument As String = "C:\Users\SDETHBP\Documents\FCM\FCM Ulvetræning Øvelser\U7-U12\Word Forside\Forside fra Excel.docx"
      
    'Word objects/declared variables.
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
      
    'Excel objects
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    
    'Instantiate Word and open the "Table Reports" document.
    Set wdApp = New Word.Application
    'Making word App Visible
    wdApp.Visible = True
    Set wdDoc = wdApp.Documents.Add(stWordDocument)
         
    ' copy content to word
    ThisWorkbook.Worksheets("U7AB1").Range("A1:N24").Copy
    
    ' Pastes it to the selected Word doc template.
    wdApp.Documents.Add
    wdApp.Selection.Paste
    
    ' Sets your printer in Word to Adobe PDF and then prints the whole doc.
    wdApp.WordBasic.FilePrintSetup Printer:="Adobe PDF", DoNotSetAsSysDefault:=1
    wdApp.ActiveDocument.PrintOut
    
    'Cleaning
    Set wsCell = Nothing
    Application.StatusBar = "Cleaning up..."
    Set wdDoc = Nothing
    wdApp.Visible = True
    Set wdApp = Nothing
    Application.StatusBar = False
End Sub

希望有人能指导一下。

##编辑尝试：## 我已经尝试过这个，并且将我现有的word文件并将excel表中的范围填充到其中，但是我的水印在“表格”后面，我看不到它（知道我还没有保存为pdf ）。 所以atm。就是布局的问题，如果我选择单元格/范围手册，然后将em复制到word中，没关系，我可以看到我的水印。

Sub ExcelRangeToWord()

'PURPOSE: Copy/Paste An Excel Table Into a New Word Document
'NOTE: Must have Word Object Library Active in Order to Run _
  (VBE > Tools > References > Microsoft Word 12.0 Object Library)
'SOURCE: www.TheSpreadsheetGuru.com

Dim tbl As Excel.Range
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table

'Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False

'Copy Range from Excel
  Set tbl = ThisWorkbook.Worksheets("U7AB1").Range("A1:N24")

'Create an Instance of MS Word
  On Error Resume Next
    
    'Is MS Word already opened?
      Set WordApp = GetObject(class:="Word.Application")
    
    'Clear the error between errors
      Err.Clear

    'If MS Word is not already open then open MS Word
      If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application")
    
    'Handle if the Word Application is not found
      If Err.Number = 429 Then
        MsgBox "Microsoft Word could not be found, aborting."
        GoTo EndRoutine
      End If

  On Error GoTo 0
  
'Make MS Word Visible and Active
  WordApp.Visible = True
  WordApp.Activate
    
'Create a New Document
  'Set myDoc = WordApp.Documents.Add
'Change: [Set myDoc = WordApp.Documents.Add] to:
  Set myDoc = WordApp.Documents.Open("C:\Users\SDETHBP\Documents\FCM\FCM Ulvetræning Øvelser\U7-U12\Word Forside\Forside fra Excel.docx")
  
'Copy Excel Table Range
  tbl.Copy

'Paste Table into MS Word
  myDoc.Paragraphs(1).Range.PasteExcelTable _
    LinkedToExcel:=False, _
    WordFormatting:=False, _
    RTF:=False
  
EndRoutine:
'Optimize Code
  Application.ScreenUpdating = True
  Application.EnableEvents = True

'Clear The Clipboard
  Application.CutCopyMode = False

End Sub  

Answer 1

例如：

Sub CopyToWordAndPrintPDF()
'PURPOSE: Copy/Paste An Excel Table Into a New Word Document
'NOTE: Must have Word Object Library Active in Order to Run _
(VBE > Tools > References > Microsoft Word #.0 Object Library)
      
'Name of the existing Word document
Const stWordDocument As String = "C:\Users\SDETHBP\Documents\FCM\FCM Ulvetræning Øvelser\U7-U12\Word Forside\Forside fra Excel.docx"
      
'Word objects/declared variables.
Dim wdApp As New Word.Application, wdDoc As Word.Document
    
With wdApp
  .Visible = False
  ' Open the Word document
  Set wdDoc = .Documents.Open(Filename:=stWordDocument, AddToRecentFiles:=False, Visible:=False)
         
  ' copy content to word
  ThisWorkbook.Worksheets("U7AB1").Range("A1:N24").Copy
    
  ' Pastes it to the selected Word template.
  With wdDoc
    .Range.Characters.Last.Paste ' or, for example: .PasteExcelTable False, False, True
    ' Saves then prints the doc.
    .SaveAs2 Filename:=Split(stWordDocument, ".doc")(0) & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
    .Close False
  End With
  .Quit
End With
Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

要使用工作簿的名称和路径而不是 PDF 的文档名称和路径，请更改：

Split(stWordDocument, ".doc")(0)

到：

Split(ThisWorkbook.FullName, ".xls")(0)