У меня есть документ с несколькими буквами, разделенными разрывами разделов.
Что я хочу сделать - это разбить документ на несколько документов, содержащих 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