Объединить документы из папки - PullRequest
0 голосов
/ 02 апреля 2020

У меня есть документ с несколькими буквами, разделенными разрывами разделов.

Что я хочу сделать - это разбить документ на несколько документов, содержащих X число буквы (без их выбора вручную).

Что я сделал - это разделил его на отдельные буквы одним макросом (BreakOnSection), а затем объединил их с другим (MergeMultiDocsIntoOne), который открывает браузер файлов и позволяет мне выбирать файлы, которые я хочу, вручную. Ниже приведены макросы.

Основной вопрос: Если основной документ разделен, скажем, на 100 документов меньшего размера, можно ли изменить второй макрос, поэтому он автоматически выбирает 10 из их из папки, объединяет / объединяет их, создавая новый документ, а затем переходит к другому пакету из 10 и так далее?

Первый макрос:

Sub BreakOnSection()

'Criteria for moving through the document by section.
Application.Browser.Target = wdBrowseSection

'For i = 1 To ((ActiveDocument.Sections.Count) - 1)
For i = 1 To ActiveDocument.Sections.Count

    'Copy the whole section
    ActiveDocument.Bookmarks("\Section").Range.Copy

    'Create a new document to paste text from the clipboard.
    Documents.Add
    Selection.Paste

    'Removes the break that is copied at the end of the section, if any.
    Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
    Selection.Delete Unit:=wdCharacter, Count:=1

    ChangeFileOpenDirectory "C:\Users\MyUser\Desktop\MyFolder"

    DocNum = DocNum + 1
    ActiveDocument.SaveAs Filename:="letter_" & DocNum & ".docx"
    ActiveDocument.Close

    'Move the selection to the next section
    Application.Browser.Next

Next i

ActiveDocument.Close savechanges:=wdDoNotSaveChanges
'ActiveDocument.Close savechanges:=wdSaveChanges

End Sub

Второй макрос:

Sub MergeMultiDocsIntoOne()
  Dim dlgFile As FileDialog
  Dim nTotalFiles As Integer
  Dim nEachSelectedFile As Integer

  Set dlgFile = Application.FileDialog(msoFileDialogFilePicker)

  With dlgFile
    .AllowMultiSelect = True
    If .Show <> -1 Then
      Exit Sub
    Else
      nTotalFiles = .SelectedItems.Count
    End If
  End With

  For nEachSelectedFile = 1 To nTotalFiles
    Selection.InsertFile dlgFile.SelectedItems.Item(nEachSelectedFile)
    If nEachSelectedFile < nTotalFiles Then
      Selection.InsertBreak Type:=wdPageBreak
    Else
      If nEachSelectedFile = nTotalFiles Then
        Exit Sub
      End If
    End If
  Next nEachSelectedFile
End Sub

1 Ответ

0 голосов
/ 03 апреля 2020

Вместо того, чтобы разбивать все разделы на отдельные документы, прежде чем объединять их, вам гораздо лучше просто разбить исходный документ на столько блоков, сколько вам нужно. См., Например, Разделить объединенный вывод для отдельных документов в Советы и рекомендации по Mailmerge в: https://www.msofficeforums.com/mail-merge/21803-mailmerge-tips-tricks.html. Хотя код, который был написан для обработки вывода mailmerge, будет работать так же хорошо с любым многосекционным документом, который вы можете разбить на равные числа секций.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...