ワード作成した名刺の大量印刷について

ワードでイラストや写真を含んだ、名刺を大量に作成すると、ワードがフリーズしてしまう。かなり悩んでいます。
個人情報の内容や、名刺の文章、イラスト、写真の配置などが、ことなる名刺をワードで、大量に作成し、表面と裏面を合わせて両面で1500枚(3000面)ほど作りました。

1500枚をまとめて、1つのワードファイル内に保存しているのではなく、1つのワードファイル内に表面と裏面の文章、イラスト、写真を配置して、それを全てグループ化まで完了しています。つまり、ワードファイルが合計1500ファイルあります。

今度は、この名刺1500枚を印刷しよう思うのですが、この印刷をいちいち自分で印刷するとなると、裁断まで含めると大変過ぎてしまいます。(今後もこの1500枚を何度も定期的に繰り返し印刷する予定です)。

なので、ワードをpdf化して、印刷業者にそのデータを送るという方法にすることにしました。
ワードの挿入タブで名刺の型、高さ55mm×幅91mmサイズを1ページに10個あります。
この型に、前述の1500あるワードのファイルから、1枚1枚グループ化したものをドラッグして移動していくと、名刺が7枚分ほどドラッグしたところで、ワードが「応答なし」のようなメッセージが出てきてフリーズしてしまい、作業がさっぱり進みません。
ドラッグする数が増えるほど、動きも遅くて進みません。


付属画像の上の方が即にグループ化して保存した名刺の内容を、高さ55mm×幅91mmサイズを1ページに10個ある型のうち、そのうち4つにドラッグした例になります。

そして、下のワードファイルが名刺情報や写真、イラストが書かれていて、グループ化が完了した名刺1枚分のファイルの写真です。ファイルは合計1500個あります。ファイル名はイラスト名で保存しています。

イラストは全てワードの図形を組み合わせて書いたものです。印刷にはあまりくわしくないです。劣化もしないようにしたいです。

何かよい方法はないでしょうか？ 回答よろしくお願いいたします。
印刷代や名刺用紙の裁断費用は含めないとして、予算は月4000円までしか出せません。

使用スペック windows10 ワード2021

No.4 回答者： hnks192059 回答日時： 2025/05/07 13:15

folderPath = "〇〇〇〇" の部分は実際にdocxファイルがあるフォルダパスに変更し、このファイルを保存する。

（保存するときは必ず「文字コード：ANSI」にしてください）

で、このvbsファイルをダブルクリックして実行すると動作します。

まずはテスト的にdocxを5ファイルぐらい置いたフォルダで試してみてください。

No.3 回答者： hnks192059 回答日時： 2025/05/07 13:14

任意のフォルダに拡張子「.vbs」のファイルを作成し、メモ帳で下記を貼り付けてください。

Option Explicit

Dim folderPath, fso, folder, files, file
Dim wordApp, doc
Dim wmi, printJobs

' ★ここを処理対象のフォルダに変更してください
folderPath = "C:\Users\YourName\Documents\名刺データ"

Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderPath)
Set files = folder.Files

Set wordApp = CreateObject("Word.Application")
wordApp.Visible = False

For Each file In files
If LCase(fso.GetExtensionName(file.Name)) = "docx" Then
Set doc = wordApp.Documents.Open(file.Path)

' 印刷開始
doc.PrintOut

' 印刷ジョブが終了するまで待つ
Do While Not IsPrintQueueEmpty()
WScript.Sleep 2000 ' 2秒待機
Loop

doc.Close False
Set doc = Nothing
End If
Next

wordApp.Quit
Set wordApp = Nothing

MsgBox "すべてのWord文書を印刷しました。"

' 印刷ジョブが空かを確認する関数（既定のプリンタを対象）
Function IsPrintQueueEmpty()
Set wmi = GetObject("winmgmts:\\.\root\cimv2")
Set printJobs = wmi.ExecQuery("SELECT * FROM Win32_PrintJob")
IsPrintQueueEmpty = (printJobs.Count = 0)
Set printJobs = Nothing
Set wmi = Nothing
End Function

No.2 回答者： hnks192059 回答日時： 2025/05/07 13:13

キューに溜まった印刷物が印刷完了しきる前にどんどん作業を進めていっていることが原因だと思われます。

一つのdocxファイルごとに順番に印刷を実行するようなVBScriptを作成して実行すれば追加費用は不要です。

No.1 回答者： bari_saku 回答日時： 2025/05/07 12:59

サイズが大きいファイルが多いとか？

ファイルサイズが小さい順に並べ直して、まとめて印刷してみてはいかがでしょう。