Вставить первую и последнюю страницу документа (docx) в другой docx

Question

У меня есть несколько файлов слов, из которых я пытаюсь извлечь первую и последнюю страницу и скопировать в другой документ.

Я попробовал следующий код, но смог частично его запустить, первая страницакопируется в новый документ, однако я не могу заставить работать последнюю копию страницы, поскольку последняя перезаписывает первую скопированную страницу.как переместить курсор на конечную страницу до того, как будет скопирована последняя страница.

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. Это также оставляет содержимое буфера обмена пользователя нетронутым.

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