Question

我有一些Word文件，我试图从中提取第一页和最后一页并复制到另一个文档中。

我尝试了以下代码，能够部分工作，将第一页复制到新文档中，但是由于最后一页覆盖了复制的第一页，因此我无法使最后一页的副本正常工作。如何在最后一页被复制之前将课程进程移动到结束页。

Sub getfirstlast()


Dim Counter As Long, Source As Document, Target As Document
Dim strFolderA As String
Dim strFileSpec As String
Dim strFileName As String
Dim objDocA As Word.Document

strFolderA = InputBox("Enter path to document:")
strFileSpec = "*.docx"
strFileName = Dir(strFolderA & strFileSpec)

Set objDocA = Documents.Add
 Documents.Open (strFolderA & strFileName)


Set Source = ActiveDocument
ActiveDocument.PageSetup.Orientation = wdOrientLandscape
Selection.HomeKey unit:=wdStory
Pages = Source.BuiltInDocumentProperties(wdPropertyPages)

Counter = 0
'MsgBox "number of pages:" & Pages

While Counter < Pages
   Counter = Counter + 1

 'first page
  If Counter = 1 Then
    Source.Bookmarks("\Page").Range.Copy
    Set Target = objDocA
    Target.Range.Paste

 End If

   'last page
   If Counter = Pages Then

    Source.Bookmarks("\Page").Range.Copy
    Set Target = objDocA
    Target.Activate
    Selection.EndKey unit:=wdStory
    Target.Range.Paste

 End If

Wend


Target.PageSetup.Orientation = wdOrientLandscape
Target.SaveAs FileName:=strFolderA & Replace(strFileName, ".docx", "_.docx")
Target.Close

End Sub

Answer 1

为了简化任务，我对问题中的代码进行了一些更改。

在可重现的过程中，尚不清楚路径和文件名信息以及打开文档应该发生什么。我注释了Documents.Open行，但是基于一个假设，即这应该是源文档，提出了一个建议。我测试的代码使用下面的一行，ActiveDocument。

可以使用GoTo方法直接跳到特定页面。这将比循环页面更快，尤其是在大型文档中。

使用GoTo和内置\Pages书签需要Selection对象，并且源文档必须是活动文档。

但是写到目标可以使用Range对象。请注意，对于这种工作，最好使用单独的对象，而不要使用Document.Range。然后，诀窍是Collapse Range以添加信息（而不是替换范围内容）。

虽然问题中的“复制/粘贴”方法确实有效，但使用Range.FormattedText属性在Word文档内或Word文档之间传输内容会更有效。这也使用户的剪贴板内容完整无缺。

Sub getfirstlastPagesToNewDocument()
    Dim Counter As Long, Pages As Long, Source As Document
    Dim strFolderA As String
    Dim strFileSpec As String
    Dim strFileName As String
    Dim objDocA As Word.Document
    Dim rngTarget As Word.Range, rngSource As Word.Range

    strFolderA = InputBox("Enter path to document:")
    strFileSpec = "*.docx"
    strFileName = Dir(strFolderA & strFileSpec)
    '??SEt Source = Documents.Open (strFolderA & strFileName)
    Set Source = ActiveDocument
    Set objDocA = Documents.Add
    Set rngTarget = objDocA.content

    Source.PageSetup.Orientation = wdOrientLandscape
    Source.Activate
    Selection.HomeKey unit:=wdStory
    Pages = Source.BuiltInDocumentProperties(wdPropertyPages)

    Selection.GoTo What:=Word.wdGoToAbsolute, Which:=Word.wdGoToPage, Count:=1
    Set rngSource = Selection.Bookmarks("\Page").Range
    rngTarget.FormattedText = rngSource.FormattedText
'    Selection.Bookmarks("\Page").Range.Copy
'    rngTarget.Paste

    Selection.GoTo What:=Word.wdGoToAbsolute, Which:=Word.wdGoToPage, Count:=Pages
    Set rngSource = Selection.Bookmarks("\Page").Range
'    Selection.Bookmarks("\Page").Range.Copy
    rngTarget.Collapse wdCollapseEnd
    rngTarget.FormattedText = rngSource.FormattedText
'    rngTarget.Paste

    objDocA.PageSetup.Orientation = wdOrientLandscape
    objDocA.SaveAs fileName:=strFolderA & Replace(strFileName, ".docx", "_.docx")
    objDocA.Close

End Sub

将文档（docx）的首页和末页粘贴到另一个docx中

1 个答案: