有没有办法使用 Excel 中的 VBA 复制 Word 页面？

如何解决有没有办法使用 Excel 中的 VBA 复制 Word 页面？

我正在尝试指定从 Excel vba 代码复制 Word 文档第一页的次数。但我不断收到错误消息。

我基本上试图始终选择文档的第一页并在文档末尾复制它。并按照用户在工作表单元格中定义的次数重复相同的过程。

相关代码如下：

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Interceramic") 'Elección de la hoja de cálculo'
Dim objword As Object
Set objword = CreateObject("Word.Application") 'Declaración y configuración de la aplicación word'
objword.Visible = True
objword.Documents.Open ThisWorkbook.Path & "\interceramic_base.docx" 'Elección del documento de word base'

Dim paginas As Integer

paginas = ws.Range("N1").Value

For i = 1 To paginas
    objword.Selection.Goto what:=wdGoToPage,Which:=wdGoToPrevIoUs,Name:="1"
    objword.ActiveDocument.Bookmarks("\Page").Range.copy
    objword.Selection.Goto what:=wdGoToPage,Which:=wdGoToNext,Count:=-1
    objword.Selection.Paste
Next

不断弹出的错误是：“错误'4608'：应用程序或对象定义的错误”。

我真的不知道代码有什么问题，我已经用尽了我能找到的所有相关信息。

编辑以供将来参考：我尝试了其他用户解释的解决方案无济于事。但我解决了这个问题，把代码改成这样：

Dim objword As Word.Application
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Interceramic") 'Elección de la hoja de cálculo'
Set objword = CreateObject("Word.Application") 'Declaración y configuración de la aplicación word'
objword.Visible = True
objword.Documents.Open ThisWorkbook.Path & "\interceramic_base.docx" 'Elección del documento de word base'

Dim pags As Variant

pags = ws.Range("N1").Value - 1
For i = 1 To pags
    With objword
        .ActiveDocument.Bookmarks("\Page").Select
        .Selection.copy
        .Selection.EndKey unit:=wdStory
        .Selection.InsertNewPage
        .Selection.Paste
    End With
Next

解决方法

您使用的是后期绑定，因此 Excel 无法理解 wdGoToPage、wdGoToPrevious 或 wdGoToNext 的含义。您需要改用它们的值：

wdGoToPage = 1
wdGoToNext = 2
wdGoToPrevious = 3

但是，有一种更好的方法可以避免同时使用 Selection 对象和剪贴板。

   Dim ws As Worksheet
   Set ws = ThisWorkbook.Sheets("Interceramic") 'Elección de la hoja de cálculo'
   Dim objword As Object
   Set objword = CreateObject("Word.Application") 'Declaración y configuración de la aplicación word'
   objword.Visible = True
   Dim objDoc As Object
   Set objDoc = objword.Documents.Open(ThisWorkbook.Path & "\interceramic_base.docx")  'Elección del documento de word base'

   Dim paginas As Integer

   paginas = ws.Range("N1").Value
   Dim rng As Object
   Set rng = objDoc.Content
   rng.Collapse 1 'wdCollapseStart

   For i = 1 To paginas
      With objDoc.Paragraphs.Last.Range
         .InsertParagraphAfter
         .FormattedText = rng.Bookmarks("\Page").Range.FormattedText
      End With
   Next

编辑：

您的文档仅包含一个表格。您在第一页看到的大部分内容都在标题中。您无法通过复制和粘贴来复制该页面。

我假设您复制页面的目的是创建一些相关的“文档”。如果是这种情况，您应该将该文档保存为模板 (.dotx) 并使用它来创建单独的文档，或者，如果您需要使用工作簿中的数据填充文档，则将其作为邮件合并模板。

编辑 2：

以下代码已在您的文档上进行了测试，并且在 O365 中正常运行，没有错误。

注意：我不推荐这种方法，因为它不是好的做法。您应该始终从模板创建文档。如果您想从 Excel 数据创建多个文档（发票？），最好的选择是使用邮件合并。

   Dim ws As Worksheet
   Set ws = ThisWorkbook.Sheets("Interceramic") 'Elección de la hoja de cálculo'
   Dim objword As Object
   Set objword = CreateObject("Word.Application") 'Declaración y configuración de la aplicación word'
   objword.Visible = True
   Dim objDoc As Object
   Set objDoc = objword.Documents.Open(ThisWorkbook.Path & "\interceramic_base.docx")  'Elección del documento de word base'

   Dim paginas As Integer

   paginas = ws.Range("N1").Value
   Dim rng As Object
   Set rng = objDoc.Content
   rng.Collapse 1 'wdCollapseStart
   rng.Bookmarks("\Page").Range.Copy

   Dim i As Integer
   For i = 1 To paginas
      With objDoc.Paragraphs.Last.Range
         .InsertBreak 7 'wdPageBreak
         .InsertParagraphAfter
         .Paste
      End With
   Next