前提・実現したいこと
WORD VBAで、セクションごとに分割保存するマクロを作成したいです。
章番号、ヘッダー・フッターを分割元のファイルと同じにしたまま分割することは
可能でしょうか。
発生している問題・エラーメッセージ
該当のソースコード
WORD
1Sub ファイル分割() 2' 3' ファイル分割 Macro 4' 5' 6 ' ファイル名取得 7 Dim doc As Document 8 Dim newDoc As Document 9 Dim i As Long, j As Long 10 Set doc = ActiveDocument 11 12 Dim wlen As Integer 13 Dim fn As String, ext As String 14 15 FName = ActiveDocument.Name 16 wlen = Len(FName) 17 18 For j = wlen To 1 Step -1 19 If Mid(FName, j, 1) = "." Then 20 fn = Left(FName, j - 1) 21 ext = Mid(FName, j + 1) 22 Exit For 23 End If 24 Next 25 26 27 ' Used to set criteria for moving through the document by section. 28 Application.Browser.Target = wdBrowseSection 29 30 'A mail merge document ends with a section break next page. 31 'Subtracting one from the section count stop error message. 32 For i = 1 To ((ActiveDocument.Sections.Count) - 1) 33 34 'Note: If a document does not end with a section break, 35 'substitute the following line of code for the one above: 36 'For I = 1 To ActiveDocument.Sections.Count 37 38 'Select and copy the section text to the clipboard. 39 ActiveDocument.Bookmarks("\Section").Range.Copy 40 41 'Create a new document to paste text from clipboard. 42 Documents.Add 43 Selection.Paste 44 45 'Removes the break that is copied at the end of the section, if any. 46 Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend 47 Selection.Delete Unit:=wdCharacter, Count:=1 48 ChangeFileOpenDirectory doc.Path 49 50 DocNum = DocNum + 1 51 52 ActiveDocument.SaveAs FileName:=fn & "_" & DocNum & ".doc" 53 54 ActiveDocument.Close 55 ' Move the selection to the next section in the document. 56 Application.Browser.Next 57 Next i 58 ActiveDocument.Close savechanges:=wdDoNotSaveChanges 59 60End Sub
試したこと
上記のコードだと章番号、ヘッダー・フッターが新しく設定されてしまいます。
補足情報(FW/ツールのバージョンなど)
ここにより詳細な情報を記載してください。
あなたの回答
tips
プレビュー