问使用VBA循环将Excel范围从不同的工作表复制到Word文件时遇到问题

EN

Set myDoc = WordApp.Documents.Open(Filename:=stWordDocument, AddToRecentFiles:=False, Visible:=False)

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 12.0 Object Library)
  'SOURCE: www.TheSpreadsheetGuru.com
  
  '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 test.docx"
  
  'Word objects/declared variables.
  Dim WordApp As Word.Application
  Dim myDoc As Word.Document
  Dim Ws As Worksheet
  Dim myArr As Variant, a As Variant
  Dim rangeArr As Variant
  Dim i As Integer
    
'Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False

'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
  
  With WordApp
    'Make MS Word Visible and Active
    WordApp.Visible = False
    
    'Create a loop
    myArr = Array("U7AB1", "U7AB2", "U7BC1")
    rangeArr = "A1:N24"
    
    'Set myDoc = WordApp.Documents.Add
    'Change: [Set myDoc = WordApp.Documents.Add] to:
    Set myDoc = WordApp.Documents.Open(Filename:=stWordDocument, AddToRecentFiles:=False, Visible:=False)
        
    For i = 0 To UBound(myArr)
      Set Ws = Sheets(myArr(i))
      With Ws
  
        'Copy Excel content to word
        ThisWorkbook.Worksheets(myArr(i)).Range(rangeArr).Copy
    
        With Documents(stWordDocument).PageSetup
            .LineNumbering.Active = False
            .TopMargin = CentimetersToPoints(0)
            .BottomMargin = CentimetersToPoints(0)
            .LeftMargin = CentimetersToPoints(0)
            .RightMargin = CentimetersToPoints(0)
        'Paste it to the selected Word template
            With myDoc
                .Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
                .SaveAs2 Filename:=Split(stWordDocument, ".docx")(0) & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
                '.SaveAs2 Filename:=ThisWorkbook.Name & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
                .Close False
            End With
        End With
      End With
    Next
    .Quit
  End With
                  
EndRoutine:
'Optimize Code
  Application.ScreenUpdating = True
  Application.EnableEvents = True

'Clear The Clipboard
  Application.CutCopyMode = False

End Sub