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

Question

在与 [ 相同的上下文中

因为我得到了帮助，我尝试做一个循环，因为我在作品sheet/书中的几个 sheet 上有相同的区域，我想通过复制循环到现有的 Word 文档（sheet by sheet），将其保存为 PDF 并继续下一个 sheet.

我已尝试以下操作，但出现错误：“运行-时间错误‘462’-远程服务器计算机不存在或不可用”。 用于代码行：

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

代码尝试来自 BigBen 的“更新代码”：

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

有人可以指导我吗？ 这样我就可以得到一个 PDF。 sheet，在每个 sheet 上占用相同的区域，但将其保存为独立的 pdf 文件，最好以 sheet name.pdf 命名。 来自同一个 word 文件，不应像现在一样保存，但会被使用，因为它有水印，应该为所有 sheets 再次使用。

[1]：使用 VBA

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

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 12.0 Object Library)
   'SOURCE: www.TheSpreadsheetGuru.com
  
   'filepath and word template
   Const filePath As String = "C:\Users\SDETHBP\Documents\FCM\FCM Ulvetræning Øvelser\U7-U12\"
   Const wordTemplate As String = "Word Forside\Forside fra Excel test.dotx"
  
   '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"
        
      For i = 0 To UBound(myArr)
 
         'Copy Excel content to word
         ThisWorkbook.Worksheets(myArr(i)).Range(rangeArr).Copy
    
         Set myDoc = WordApp.Documents.Add(Template:=filePath & wordTemplate, Visible:=False)
         'With Documents(stWordDocument).PageSetup
         With myDoc
            With .PageSetup
               .LineNumbering.Active = False
               .TopMargin = CentimetersToPoints(0)
               .BottomMargin = CentimetersToPoints(0)
               .LeftMargin = CentimetersToPoints(0)
               .RightMargin = CentimetersToPoints(0)
            End With
            'Paste it to the selected Word template
            .Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
            .SaveAs2 Filename:=filePath & myArr(i) & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
            .Close False
         End With
      Next
      .Quit
   End With
                  
EndRoutine:
   'Optimize Code
   Application.ScreenUpdating = True
   Application.EnableEvents = True

   'Clear The Clipboard
   Application.CutCopyMode = False

End Sub