Sub replace_texts_range_of_cells()
'Updateby ExtendOffice
Dim xWordApp As Word.Application
Dim xDoc As Word.Document
Dim xRng As Range
Dim I As Integer
Dim xFileDlg As FileDialog
On Error GoTo ExitSub
Set xFileDlg = Application.FileDialog(msoFileDialogFilePicker)
xFileDlg.AllowMultiSelect = False
xFileDlg.Filters.Add "Word Document", "*.docx; *.doc; *.docm"
xFileDlg.FilterIndex = 2
If xFileDlg.Show <> -1 Then GoTo ExitSub
Set xRng = Application.InputBox("Please select the lists of find and replace texts (Press Ctrl key to select two same size ranges):", "Kutools for Excel", , , , , , 8)
If xRng.Areas.Count <> 2 Then
MsgBox "Please select two columns (press Ctrl key), the two ranges have the same size.", vbInformation + vbOKOnly, "Kutools for Excel"
GoTo ExitSub
End If
If (xRng.Areas.Item(1).Rows.Count <> xRng.Areas.Item(2).Rows.Count) Or _
(xRng.Areas.Item(1).Columns.Count <> xRng.Areas.Item(2).Columns.Count) Then
MsgBox "Please select two columns (press Ctrl key), the two ranges have the same size.", vbInformation + vbOKOnly, "Kutools for Excel"
GoTo ExitSub
End If
Set xWordApp = CreateObject("Word.application")
xWordApp.Visible = True
Set xDoc = xWordApp.Documents.Open(xFileDlg.SelectedItems.Item(1))
For I = 1 To xRng.Areas.Item(1).Cells.Count
With xDoc.Application.Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = xRng.Areas.Item(1).Cells.Item(I).Value
.Replacement.Text = xRng.Areas.Item(2).Cells.Item(I).Value
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
xDoc.Application.Selection.Find.Execute Replace:=wdReplaceAll
Next
ExitSub:
Set xRng = Nothing
Set xFileDlg = Nothing
Set xWordApp = Nothing
Set xDoc = Nothing
End Sub
3。コードを貼り付けた後、Microsoft Visual Basic for Applicationsウィンドウで、ツール>参照設定をクリックします（スクリーンショット参照）。
4。表示された参照設定 – VBAProjectダイアログボックスで、リストからMicrosoft Word 16.0 オブジェクトライブラリを選びます（スクリーンショット参照）。
Sub FindReplaceAcrossMultipleWordDocuments()
'Updateby ExtendOffice
Dim xWordApp As Word.Application
Dim xDoc As Word.Document
Dim xRng As Range
Dim I As Integer
Dim xFolderDlg As FileDialog
Dim xFSO As Scripting.FileSystemObject
Dim xFile As File
On Error GoTo ExitSub
Set xFolderDlg = Application.FileDialog(msoFileDialogFolderPicker)
If xFolderDlg.Show <> -1 Then GoTo ExitSub
Set xRng = Application.InputBox("Please select the lists of find and replace texts (Press Ctrl key to select two same size ranges", "Kutools for Excel", , , , , , 8)
If xRng.Areas.Count <> 2 Then
MsgBox "Please select two columns (press Ctrl key), the two ranges have the same size", vbInformation + vbOKOnly, "Kutools for Excel"
GoTo ExitSub
End If
If (xRng.Areas.Item(1).Rows.Count <> xRng.Areas.Item(2).Rows.Count) Or _
(xRng.Areas.Item(1).Columns.Count <> xRng.Areas.Item(2).Columns.Count) Then
MsgBox "Please select two columns (press Ctrl key), the two ranges have the same size.", vbInformation + vbOKOnly, "Kutools for Excel"
GoTo ExitSub
End If
Set xFSO = New Scripting.FileSystemObject
Set xWordApp = CreateObject("Word.application")
xWordApp.Visible = True
For Each xFile In xFSO.GetFolder(xFolderDlg.SelectedItems(1)).Files
If VBA.InStr(xFile.Type, "Microsoft Word") > 0 Then
Set xDoc = xWordApp.Documents.Open(xFile.Path)
For I = 1 To xRng.Areas.Item(1).Cells.Count
With xDoc.Application.Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = xRng.Areas.Item(1).Cells.Item(I).Value
.Replacement.Text = xRng.Areas.Item(2).Cells.Item(I).Value
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
xDoc.Application.Selection.Find.Execute Replace:=wdReplaceAll
Next
xDoc.Close wdSaveChanges
End If
Next
xWordApp.Quit
MsgBox "The Find and Replace has been completed", vbInformation + vbOKOnly, "Kutools for Excel"
ExitSub:
Set xRng = Nothing
Set xFolderDlg = Nothing
Set xWordApp = Nothing
Set xDoc = Nothing
End Sub
3。Microsoft Visual Basic for Applicationsウィンドウで引き続き、ツール＞参照設定をクリックします。表示された参照設定 – VBAProjectダイアログボックスで、リストからMicrosoft Word 16.0 オブジェクトライブラリとMicrosoft Scripting Runtimeの各オプションを選択してください（スクリーンショット参照）。
ここでは、Excel ではなくWord そのものを使って複数のWord 文書にわたってテキストを一括で検索・置換する方法をご紹介します。強力なKutools for Word 機能を使えば、本文やヘッダー、フッター、コメントなどに含まれる特定のテキストを効率的に検索・置換でき、必要に応じて結果をハイライト表示することも可能です！
Kutools for Word
Kutools for Word は、コーディングも複雑な設定も不要。Microsoft Word に実用的なツールを直接搭載し、日常のドキュメント作業をよりスピーディーに処理するお手伝いをします。
![Microsoft Visual Basic for Applicationsウィンドウで[ツール]メニューが展開されているスクリーンショット](http://cdn.extendoffice.com/images/stories/doc-excel/find-replace-in-word-from-excel/doc-find-replace-word-file-excel-1.png)
![Wordファイルを選択するための[参照]ウィンドウのスクリーンショット](http://cdn.extendoffice.com/images/stories/doc-excel/find-replace-in-word-from-excel/doc-find-replace-word-file-excel-3.png)
![検索および置換を実行した後の[結果プレビュー]タブのスクリーンショット](http://cdn.extendoffice.com/images/stories/doc-excel/find-replace-in-word-from-excel/doc-find-replace-word-file-excel-11.png)
