質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
ファイル

ファイルとは、文字列に基づいた名前又はパスからアクセスすることができる、任意の情報のブロック又は情報を格納するためのリソースです。

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Word

Microsoft WordはMicrosoftが開発した業務用の文書生成用のソフトウェアです。

ファイルI/O

ファイルI/Oは、コンピューターにおけるファイルの入出力です。これは生成/削除やファイルを読み込んだり、出力をファイルに書き込むようなディレクトリやファイルの運用を含みます。

Q&A

解決済

1回答

7190閲覧

Wordファイルを任意のページ単位でファイル分割したい(VBA使用)

kyon-net

総合スコア7

ファイル

ファイルとは、文字列に基づいた名前又はパスからアクセスすることができる、任意の情報のブロック又は情報を格納するためのリソースです。

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Word

Microsoft WordはMicrosoftが開発した業務用の文書生成用のソフトウェアです。

ファイルI/O

ファイルI/Oは、コンピューターにおけるファイルの入出力です。これは生成/削除やファイルを読み込んだり、出力をファイルに書き込むようなディレクトリやファイルの運用を含みます。

0グッド

0クリップ

投稿2019/12/06 05:56

編集2019/12/06 07:06

Wordファイルを任意のページ単位でファイル分割したいと考えています。

例) 15ページから成る1つのwordファイルを、5ページ単位で3ファイルに分割したい。
⇒3ファイル作成(P.1~P.5、P.6~P.10、P.11~P.15)

プログラムを作成しましたが、ファイルによっては、ページ削除時に、ページ位置(ページ内のレイアウト)が崩れてしまい、正しく出力されません。

プログラムの概要
1、元ファイルをコピー(ワークファイル作成)
2、ワークファイルから出力したいページ以外を削除して、残ったページを保存する。
3、ワークファイルを削除
4、1~3の工程を繰り返す。

原因として考えられるのは、ページごとに、余白やフォントが異なること、セクション区切り・ページ区切りが設定されている、など。
※ページ削除処理部分は、わかりやすくコメント行(★)を入れてあります。

開発環境
windows10
Word2016

イメージ説明

vba

1Private Sub CommandButton1_Click() 2 3 4 'オプションボタンが選択されているか 5 If OpBtn1 = False And OpBtn2 = False And OpBtn3 = False Then 6 MsgBox ("処理を選択してください。") 7 Me.OpBtn1.SetFocus 8 Exit Sub 9 End If 10 11 12 'テキストボックスに値が入力されているか 13 If TextBox1.Text = "" Then 14 MsgBox ("ページを指定してください。") 15 Me.TextBox1.SetFocus 16 Exit Sub 17 Else 18 TextBox1.Text = Replace(Replace(Replace(Replace(Replace(StrConv(TextBox1.Text, vbNarrow), "、", ","), "―", "-"), "ー", "-"), "~", "-"), "‐", "-") 19 End If 20 21 22 Dim xDoc As Document 23 Dim xArr 24 Dim w_xarr 25 Dim I As Long 26 Dim fileName As String 27 Dim file_extension As String 28 Dim Folder_base As String 29 Dim Folder_work As String 30 Dim File_base As String 31 Dim File_work As String 32 Dim Page_base As Integer 33 34 ' Application.ScreenUpdating = False 35 36 'ファイルシステムを扱うオブジェクトを作成 37 Set FSO = CreateObject("Scripting.FileSystemObject") 38 39 '拡張子無しのファイル名を取得 40 fileName = FSO.GetBaseName(ActiveDocument.Path & Application.PathSeparator & ActiveDocument.Name) 41 42 '現在のフォルダパス 43 Folder_base = ActiveDocument.Path 44 45 'ワークフォルダパス 46 Folder_work = ActiveDocument.Path & Application.PathSeparator & fileName 47 48 '開いているファイルのフルパス 49 File_base = ActiveDocument.FullName 50 51 'ファイルの拡張子 52 file_extension = Replace(ActiveDocument.Name, fileName, "") 53 54 55 56 'wordファイルと同名のフォルダを作成 57 If Dir(Folder_work, vbDirectory) = "" Then 58 MkDir (Folder_work) 59 End If 60 61 62 'これからお世話になるワークファイルのフルパス 63 File_work = Folder_work & _ 64 Application.PathSeparator & _ 65 fileName & _ 66 "_work" & _ 67 file_extension 68 69 70 '対象のwordファイルをファイル名と同名のフォルダにコピー 71 FSO.CopyFile File_base, File_work 72 73 74 'ワークファイル オープン 75 Documents.Open fileName:=File_work 76 Documents(fileName & "_work" & file_extension).Activate 77 78 79 Set xDoc = ActiveDocument 80 81 82 If InStr(TextBox1.Text, "-") > 0 Then 83 84 '範囲指定の場合 85 w_xArr2 = Split(TextBox1.Text, "-") 86 87 ReDim w_xarr(w_xArr2(1) - w_xArr2(0)) 88 89 For I = 0 To w_xArr2(1) - w_xArr2(0) 90 w_xarr(I) = w_xArr2(0) + I 91 Next 92 93 Else 94 95 '個別指定の場合 96 w_xarr = Split(TextBox1.Text, ",") 97 98 End If 99 100 101 xPageCount = UBound(w_xarr) 102 103 104 Dim w_value As Integer 105 Dim w_count As Integer 106 Dim w_kensu As Integer 107 w_count = 0 108 w_kensu = 1 109 110 111 '対象ファイルの総ページ数 112 Page_base = xDoc.Bookmarks("\Page").Range.Information(wdNumberOfPagesInDocument) 113 114 115 If OpBtn1.Value = True Then 116 117 '分割するファイル数(割り切れない場合は余りを1ファイルにする) 118 If Page_base Mod CInt(TextBox1.Text) = 0 Then 119 120 w_kensu = Page_base / CInt(TextBox1.Text) 121 122 Else 123 124 w_kensu = Fix((Page_base / CInt(TextBox1.Text)) + 1) 125 126 End If 127 128 129 w_value = 1 130 131 132 ElseIf OpBtn2.Value = True Then 133 134 135 ReDim xArr(xPageCount) 136 137 xArr = w_xarr 138 139 140 ElseIf OpBtn3.Value = True Then 141 142 143 ReDim xArr(Page_base - xPageCount - 2) 144 145 'ループ処理で配列を検索 146 For I = 1 To Page_base 147 148 w_value = 0 149 150 For j = 0 To xPageCount 151 If StrComp(w_xarr(j), I) = 0 Then 152 153 w_value = 1 154 155 End If 156 157 Next 158 159 If w_value <> 1 Then 160 161 xArr(w_count) = I 162 w_count = w_count + 1 163 164 End If 165 166 167 Next I 168 169 170 171 End If 172 173 174 For K = 1 To w_kensu 175 176 177 178 'ページ単位にファイル分割する時の設定 179 If OpBtn1.Value = True Then 180 181 '2週目からまたワークファイルを開く 182 If K > 1 Then 183 FSO.CopyFile File_base, File_work 184 End If 185 186 Documents.Open fileName:=File_work 187 Documents(fileName & "_work" & file_extension).Activate 188 Set xDoc = ActiveDocument 189 190 191 '削除対象のページを記録しておく配列変数の設定 192 If Page_base - w_value + 1 < CInt(TextBox1.Text) Then 193 194 ReDim xArr(w_value - 2) 'ページ分割で最後に余りが出た場合 195 196 Else 197 198 ReDim xArr(Page_base - CInt(TextBox1.Text) - 1) '通常の指定されたページ分割分以外のページを削除 199 200 End If 201 202 203 204 'ループ処理で配列を検索 205 w_count = 0 206 For I = 1 To Page_base 207 208 209 210 211 If (I < w_value) Or (I > w_value + CInt(TextBox1.Text) - 1) Then 212 213 xArr(w_count) = I 214 w_count = w_count + 1 215 216 End If 217 218 219 Next I 220 221 222 223 224 w_value = w_value + CInt(TextBox1.Text) 225 226 End If 227 228 229 230 '最終ページから削除していく(1ページ目から削除していくとページ位置が変わってしまうため) 231 For I = UBound(xArr) To 0 Step -1 232 '★★★★★★★★★★★★★★★★★★★★★★★★★★★★ 233 Selection.GoTo wdGoToPage, wdGoToAbsolute, xArr(I) 234 xDoc.Bookmarks("\Page").Range.Delete 235 '★★★★★★★★★★★★★★★★★★★★★★★★★★★★ 236 Next 237 238 239 240 '編集ファイルに最終ページが含まれていない場合は、最終行の行間を編集する。 241 '※これをやらないと最終ページに空白のページが出来てしまう。 242 If xArr(UBound(xArr)) = Page_base Then 243 244 '最終ページの最終行を選択 245 Selection.GoTo wdGoToPage, wdGoToLast 246 Selection.GoTo wdGoToLine, wdGoToLast 247 248 '行間を最小にする 249 Selection.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly 250 Selection.ParagraphFormat.LineSpacing = 0.9 251 252 End If 253 254 255 '最初のページに移動する 256 Selection.GoTo wdGoToPage, wdGoToFirst 257 258 259 260 '保存 261 xDoc.Save 262 263 '対象のwordファイルをファイル名と同名のフォルダにコピー 264 FSO.CopyFile xDoc.FullName, _ 265 Folder_work & _ 266 Application.PathSeparator & _ 267 fileName & _ 268 "_" & Format(K, "000") & _ 269 file_extension 270 271 272 '閉じる 273 xDoc.Close 274 275 '削除 276 FSO.DeleteFile File_work 277 278 Next 279 280 281 Set FSO = Nothing 282 283 Application.ScreenUpdating = True 284 285 286 MsgBox ("処理が完了しました。") 287 Unload Word_Split 'フォームを閉じる 288 289End Sub

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答1

0

自己解決

外部のソフトウェア(Kutools for Word)を利用すると、任意のページ単位でファイル分割が出来ました。

投稿2019/12/10 08:27

kyon-net

総合スコア7

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問