2020年04月21日
カテゴリ： マクロ
よく公開してあるマクロを参考にさせていただくので，
私も公開しようかなと思いました。
Wordで，別ファイルに置換データ（置換ファイル）を作っておいて，置換したい文書ファイルを一括置換するマクロです。
置換ファイルは１行１データ，もちろん複数行OK。
書式：<行頭>置換文字列<tab>検索文字列<TAB>nasi<以降の文字列は無視>
改造してもっといいのができたら，私にもちょうだい＾＾
Sub 一括置換()
'
' 一括置換 Macro
'置換ファイル=*.txt
'<行頭>置換文字列<tab>検索文字列<TAB>nasi<以降の文字列は無視>
'置換文字列が空文字なのは置換しない
'正規表現の書き方がWZEditorとは違うので注意あまり複雑な正規表現は無理
'<tab>のない文字列は無視
'nasiの場合は確認しない
'エラーが出るとそこで終了する
' 作成日 2015/02/13 作成者 つかさ猫
On Error GoTo 一括置換_Error
'relファイル
Dim rel As Word.Document
'文書ファイル＝アクティブドキュメント
'Dim actdoc As Range
'ファイル名を取得する
i = InStrRev(ActiveDocument.Path, "\")
tkwpath = Left(ActiveDocument.Path, i)
With Application.FileDialog(msoFileDialogFilePicker)
.ButtonName = "選択"
.InitialFileName = tkwpath
With .Filters
.Clear
.Add "置換ファイル", "*.txt;*.doc;*.docx", 1
.Add "すべてのファイル", "*.*", 2
End With
If .Show = -1 Then
'relを読込専用で読込
Set rel = Documents.Open(.SelectedItems(1), ReadOnly:=True, Visible:=False)
Else 'キャンセル
GoTo 一括置換_End
End If
End With
'relファイルの中身すべてを配列で
Dim relline() As String
'rellineの１行の検索・置換文字列を配列で
Dim relwd() As String
'c=relの全行数
Dim c As Integer
c = rel.BuiltInDocumentProperties(wdPropertyLines)
'スキップ行
Dim relskip
relskip = "#"
ReDim relline(c)
For i = 1 To c
'relファイルの中身を全部取得
' relline(i) = Replace(rel.Paragraphs(i).Range, vbCr, "")
relline(i) = rel.Paragraphs(i).Range
'i行目をrelwdに配列で格納，区切り文字\t
If (relline(i) <> vbNewLine) Then '改行だけの行は飛ばす
relwd = Split(relline(i), Chr(9), 3)
'検索文字列と置換文字列が""じゃない
'#で始まらない
'relwdのインデックスが2以上
Dim cond(4) As Boolean '検索を実行するcondition
cond(0) = (relwd(0) <> "")
cond(2) = (Left(relwd(0), 1) <> relskip)
If (UBound(relwd) > 0) Then
cond(1) = (relwd(0) <> "")
cond(3) = True
Else
cond(1) = False
cond(3) = False
End If
If (UBound(relwd) > 2) Then
If (relwd(2) = "nasi") Then
cond(4) = True
Else
cond(4) = False
End If
End If
If (cond(0) And cond(1) And cond(2) And cond(3)) Then
' MsgBox relwd(0) & " " & relwd(1)
relwd(1) = Replace(relwd(1), vbLf, "")
relwd(1) = Replace(relwd(1), vbCr, "")
StatusBar = "検索文字列:" & relwd(1) & " 置換文字列:" & relwd(0)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = relwd(1) '検索文字列
.Forward = True '検索方向＝文末方向
.Wrap = wdFindContinue '文書の末尾まで達したら先頭から検索
.Format = False '書式検索
.MatchCase = False '大文字と小文字を区別しない
.MatchWholeWord = False '単語検索しない
.MatchByte = False '全半角の区別しない
.MatchAllWordForms = False '検索語の活用形も検索しない（英語だけ？）
.MatchSoundsLike = False '似た語の検索しない
.MatchFuzzy = False 'あいまい検索しない
.MatchWildcards = True '正規表現で検索する
.Replacement.Text = relwd(0) '置換文字列
.Replacement.Font.Bold = True '置換した文字を太字に
ret = .Execute(Replace:=2) '検索実行，確認しない
End With
End If
End If
ActiveDocument.AcceptAllRevisionsShown
Next
GoTo 一括置換_End
一括置換_Error:
MsgBox "エラーです:" & Chr(13) & Chr(10) _
& i & "行目：" & Chr(13) & Chr(10) _
& "検索文字列（" & relwd(0) & "）" _
& "置換文字列（" & relwd(1) & "）"
Resume Next
一括置換_End:
rel.Close SaveChanges:=wdDoNotSaveChanges
End Sub
お気に入りの記事を「いいね！」で応援しよう
【毎日開催】
15記事にいいね！で1ポイント
© Rakuten Group, Inc.
