複数のWord文書に対して文字列リストを元に連続して置換するマクロ
以前、Wordに関する次の二つのマクロを紹介しました。
Wordで文字列リストを元に連続して置換するマクロ
複数のWord文書に対して文字列置換
今般、「これらを組み合わせたい」という要望をいただきましたので、試してみました。
2020年7月18日追記
「下階層のファイルにも対応させたい」という要望をいただきましたので、試してみました。
目次
準備
適当なフォルダに文字列置換したいWordファイルを保存します。これを「対象フォルダ」と呼びます。
確認せずに一気に置換して上書き保存しますので、これらのファイルは必ずバックアップを取っておいてください。
利用に関しては自己責任でお願いします。
リスト
マクロ実行用のWordファイルを準備します。「対象フォルダ」とは別のフォルダに保存します。
本文に次のようなリストを書いておきます。
置換前と置換後の文字列を並べ、セミコロン(;)で区切ります。
プリンター;プリンタ
サーバー;サーバ
コード
次のコードを使います。使い方が分からない場合は「マクロを書く方法」を参照してください。
マクロを実行するとフォルダを選ぶダイアログが出ます。「対象フォルダ」を選択してください。
選択するとフォルダ内のファイルが順に開き、リストに従って次々に置換が実行され、上書き保存されます。
Dim mae(100)
Dim ato(100)
'置換用配列
Set paras = ActiveDocument.Paragraphs
x = 0
For i = 1 To paras.Count
thisline = paras(i).Range.Text
parts = Split(thisline, ";")
If UBound(parts) > 0 Then
mae(x) = parts(0)
ato(x) = Replace(parts(1), Chr(13), "")
x = x + 1
End If
Next i
'フォルダの選択
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "フォルダを選択"
.AllowMultiSelect = False
If .Show = -1 Then
mypath = .SelectedItems(1) & "\"
Else
MsgBox "終了します。"
Exit Sub
End If
End With
'Word文書に対する処理
myfile = Dir(mypath & "*.doc*")
Do While myfile <> ""
Documents.Open FileName:=mypath & myfile
For i = 0 To x - 1
Call 文書全体を置換(mae(i), ato(i))
Next i
ActiveWindow.Close SaveChanges:=wdSaveChanges
myfile = Dir
Loop
End Sub
Function 文書全体を置換(mae, ato)
Set myrange = ActiveDocument.Range(Start:=0, End:=0)
With myrange.Find
.ClearFormatting
.Text = mae
With .Replacement
.ClearFormatting
.Text = ato
End With
.Execute Replace:=wdReplaceAll
End With
End Function
下階層対応版
「下の階層を含めたファイル一覧を作成するマクロ」を参考にして、指定したフォルダの配下のフォルダに対応したバージョンを作りました。
宣言以降、全てのコードを下のとおり、まとめました。全てをコピー＆ペーストするだけで使えます。
Dim last_index
Sub 複数文書連続処理_リストを元に置換()
Dim mae(100)
Dim ato(100)
'置換用配列
Set paras = ActiveDocument.Paragraphs
x = 0
For i = 1 To paras.Count
thisline = paras(i).Range.Text
parts = Split(thisline, ";")
If UBound(parts) > 0 Then
mae(x) = parts(0)
ato(x) = Replace(parts(1), Chr(13), "")
x = x + 1
End If
Next i
'フォルダの選択
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "フォルダを選択"
.AllowMultiSelect = False
If .Show = -1 Then
mypath = .SelectedItems(1) & "\"
Else
MsgBox "終了します。"
Exit Sub
End If
End With
'全てのファイル名を取得（下階層を含む）
Call get_files(mypath)
'Word文書に対する処理
j = 0
Do
Documents.Open FileName:=all_files(j, 1) & all_files(j, 0)
For i = 0 To x - 1
Call 文書全体を置換(mae(i), ato(i))
Next i
ActiveWindow.Close SaveChanges:=wdSaveChanges
j = j + 1
Loop Until all_files(j, 0) = ""
End Sub
Function 文書全体を置換(mae, ato)
Set myrange = ActiveDocument.Range(Start:=0, End:=0)
With myrange.Find
.ClearFormatting
.Text = mae
With .Replacement
.ClearFormatting
.Text = ato
End With
.Execute Replace:=wdReplaceAll
End With
End Function
Function get_files(my_path)
'Word用
'指定したフォルダにある全てのファイル名(パス付)を取得する。
Dim this_file(999) As String
Dim this_path As String
Dim i As Long
Dim j As Long
this_file(0) = Dir(my_path, vbDirectory)
i = 0
Do
i = i + 1
this_file(i) = Dir
Loop Until this_file(i) = ""
For j = 0 To i - 1
If this_file(j) <> "." And this_file(j) <> ".." Then
If GetAttr(my_path & this_file(j)) = vbDirectory Then
Call get_files(my_path & this_file(j) & "\")
ElseIf InStr(this_file(j), ".doc") > 0 Then
all_files(last_index, 0) = this_file(j)
all_files(last_index, 1) = my_path
last_index = last_index + 1
End If
End If
Next j
End Function
2022年5月24日追記
Word文書以外が保存されている場合でも対応できるように修正しました。
[ 2020年5月22日 | カテゴリー: Word | タグ: VBA , 置換 ]
« 岡田眞澄の家系図 | 今、東京でコロナに感染するのは宝くじの1等または前後賞に当たるのとほぼ同じ »
コメント
-
＞新後閑真さん
チェックしたところ、コードに誤りがありました。失礼しました。
（「mypath = .SelectedItems(1) & “\”」の部分が「mypath = .SelectedItems(1) & “”」となっていました。ブログにペーストするときに必要な部分が消えてしまいました。）
お手数ですが、再度、試していただけると助かります。
よろしくお願いします。 -
新後閑真 より:
＞stabuckyさま
修正いただき、ありがとうございます！
動作確認したところ、無事に置換できました！！ -
ありがとうございます。お役に立てたのであれば幸いです。
-
kremlin より:
いつも画期的なマクロを公開していただき使わせて頂いております。一つ相談なのですが、親フォルダを指定したらその親フォルダ配下のすべてのフォルダに保存されているwordファイルを置換するように出来ますでしょうか。無理を言いまして、申し訳ありませんが、御一考のほどよろしくお願い致します。
-
kremlinさん
了解しました。
お約束はできませんが検討してみます。 -
kremlinさん
下階層対応版を書いてみました。
試していただけると助かります。
バックアップを忘れずにお願いします。 -
stabucky様
早速ありがとうございます。
来週、試させて頂きます。
職場環境がソフトのインストールができない環境なので
stabucky様のマクロは非常に助かります。
また、使用後、返信させて頂きます。
ありがとうございます。 -
kremlinさん
よろしくお願いします。 -
stabucky様
お世話になっております。
ただいま、作成していただいたマクロを
実行した結果、「実行時エラー52ファイル名または番号が不正です。」とメッセージが表示されて実行できませんでした。
デバックで見ると、this_file(0)=dir(my_path,vbdirectory)の部分で
停止しておりました。
私の環境の問題でしょうか。お手数おかけ致しますが、時間があるときに見ていただけると幸い -
kremlinさん
私の環境では再現しませんでした。
考えられる点としては。
VBAのコードで
mypath = .SelectedItems(1) & “\”
の最後の部分が”￥”となっていますでしょうか。
確認ください。 -
stabucky様
おはようございます。
ご連絡いただきました箇所を確認したところ、￥になっておりました。素人考えですが、当方の環境がネットワークドライブであったり階層深かったりフォルダ名が悪さしているのかなと考えています。今回は大変お手数おかけいたしました。これ以上お手数おかけ致すわけには行きませんので、一つずつ置換していきます。ありがとうございました。 -
なかそ より:
とても役立ちました！
ありがとうございます。
kremlinさんと同じエラーが出たのですが、フォルダ内にdoc以外の関係ない文書が混ざってたのが原因っぽかったです -
なかそさん
お役に立てて嬉しいです。
エラーに関するヒント、ありがとうございました。 -
.pdfや.xlsが入っていると動作しないので、それは除去したのですが、
どうやら.DOCと大文字になっているのもエラーの原因のようです。
とりあえず拡張子を手動で小文字にして対処しました。ご報告まで。 -
なかそさん
ありがとうございます。
ソースを見たところ、確かに、拡張子が小文字のdoc以外を想定していないですね。
また、パスがフォルダかファイルかの判定を拡張子を使うという安易な方法でやっています。 -
くり より:
初めまして。
取引先の社名変更により大量のファイル内の社名等を変更しなくてはならなくなり、何か方法はないかと探していたところこちらに辿り着きました。
マクロは全くの初心者で、マクロを書く方法を参照させていただきやってみたところ、ほとんどはうまくいきましたが、ヘッダに入っている文言には効きませんでした。
ヘッダフッタの置換というのはまた別のコードが必要なのでしょうか。
また、文中のある文言を削除するということもやりたいのですが、それは置換という形では難しいのでしょうか。また別のコードが必要なのでしょうか。
お手数をおかけし申し訳ございませんがご教示いただけますと幸いです。
よろしくお願いいたします。 -
くりさん
ヘッダ、フッタは別になります。段落ではないので。
削除は置換後の文字列を空文字にすればできると思います。 -
ご回答ありがとうございます。
ヘッダ、フッタ内のデータの置換も同時に行いたいのですが方法があればご教示いただけますと幸いです。
削除につきまして、空文字にしてみましたがうまくいきませんでした。もう1度試してみます。 -
ここ より:
初めまして。
ワードマクロどころかマクロ自体全く初心者ですが、こちらの機能が今行いたいことにぴったりでしたので拝見して挑戦しております。一点質問なのですが、文字は変えず、それぞれの色に変更だけを行うとは可能でしょうか。
つまり、
エディタ;エディタ ←黒文字の”エディタ”から、赤文字の”エディタ”に変えたい
プリンタ;プリンタ ←青文字に変えたい
サーバ;サーバ ←緑文字に変えたいといった具合です。
お手数をおかけし申し訳ございませんがご教示いただけますと幸いです。
よろしくお願いいたします。 -
くりさん
今手元にExcelが使える環境がありません。機会があれば試したいと思います。申し訳ありません。 -
ここさん
今手元にExcelが使える環境がありません。機会があれば試したいと思います。申し訳ありません。 -
お忙しい中コメントありがとうございます。
こちらこそ、お手数おかけしました。既にとても役立っています！ありがとうございます！
-
くりさん
＞削除につきまして、空文字にしてみましたがうまくいきませんでした。もう1度試してみます。
試したところできました。再度確認ください。
＞ヘッダ、フッタ内のデータの置換も同時に行いたいのですが方法があればご教示いただけますと幸いです。
ヘッダ置換用の関数を作りました。
Function ヘッダを置換(mae, ato)
Set myrange = ActiveDocument.Sections(1).Headers(1).Range
With myrange.Find
.ClearFormatting
.Text = mae
With .Replacement
.ClearFormatting
.Text = ato
End With
.Execute Replace:=wdReplaceAll
End With
End Functionそして本体「複数文書連続処理_リストを元に置換」に次の通り挿入します。
For i = 0 To x – 1
Call 文書全体を置換(mae(i), ato(i))
Call ヘッダを置換(mae(i), ato(i))
Next i私の環境では一応動きました。
フッタも必要であれば同じように作ってください。 -
ここさん
色を変えるには検索文字列、置換元の色、置換文字列、置換先の色の四つが必要になります。コードを書き換えるのは大掛かりになるので諦めました。
代わりに色を変えて置換するマクロを書いてみました。
https://stabucky.com/wp/archives/14428
文字列を置換しない場合は検索文字列と置換文字列を同じものにします。 -
お返事に今気が付いたためお礼が遅くなり申し訳ありません。
大変便利です！とても助かります！お忙しい中ご対応有難うございました。
-
ここさん
お役に立てたのであれば嬉しいです。 -
お礼が遅くなり申し訳ございません。
ご教示いただき大変助かりました！ありがとうございました。 -
ken より:
はじめてまして。
いつもお世話になっております。本記事、フォルダ内においてpdf,xlsxなど他拡張子が
混在している場合の対処法をご教示いただきたくお願いします。(15. なかそ様のコメント)各サブフォルダなどで除去すれば良いのですが、
膨大なサブフォルダの為、手間が掛かってしまいます。お手すきの際で構いませんので、ご検討いただけますと幸甚です。
よろしくお願いいたします。 -
＞kenさん
下階層対応版について、Word文書以外があっても無視するように修正しました。
お試しいただけると幸いです。
ありがとうございます！
さっそく試してみたのですが、なぜか上手くいきませんでした泣
私の操作が問題なのかもしれないのですが、「Wordで文字列リストを元に連続して置換するマクロ、複数のWord文書に対して文字列置換」は上手く作動したのですが、、、