ExcelデータをWordのテンプレートに転記(VBA)

みなさん、こんにちは^^　お久しぶりです！
リクエストを受けまして、タイトルのとおり、
Wordの定型フォームにExcelのデータを入力するVBA作りました！
(1行1ファイル作成)

内容は動画を参照ください。
ちなみに私が作成したソースは一番下に載せてますので、
コピペしてみてください^^

■ツール使用方法

■VBAのちょっとした解説

ソースコードは下記　※プロじゃないので突っ込みどころ満載かも(泣)

↓　　　　↓　　　　↓　　　　↓　　　　↓

Option Explicit

Dim strPath As String

Dim i As Long, j As Long, TitleRow As Long, cnt As Long

'iは行の移動用、jは列に移動用。TitleRowはタイトル取得用。cntはデータ処理カウント用。

Dim wdApp As Word.Application, wdDoc As Word.Document

Sub MakeWord()

cnt = 0 '処理件数の初期値

TitleRow = 5 'タイトルの行を入力 ※データ開始よりも上の行を挿入削除した場合、変更要

i = TitleRow + 1 'データ開始行セット※タイトル行+1

Set wdApp = CreateObject("Word.Application")

wdApp.Visible = True

    

Do While Cells(i, 1) <> ""

    If Cells(i, 9) = "" Then 'ステータスがブランクだったら実行

        Set wdDoc = wdApp.Documents.Open(ActiveWorkbook.Path & "\template.docx")

    

        For j = 2 To 8 '今回は2行目～8行目の内容をWord更新したい。

            With wdDoc.Content.Find

                .Text = "●" & Cells(TitleRow, j) & "●"

                .Execute Replace:=wdReplaceAll, replacewith:=Cells(i, j)

            End With

        Next

        

        wdDoc.SaveAs2 ActiveWorkbook.Path & "\" & Cells(i, 1) & ".docx"  '1行目をファイル名とする。

        Set wdDoc = Nothing

        Cells(i, 9) = "済" '列挿入時変更要

        Cells(i, 10) = Now() '列挿入時変更要

        cnt = cnt + 1

    End If

    i = i + 1

Loop

wdApp.Quit

Set wdApp = Nothing

MsgBox cnt & " 件完了しました!", vbInformation

End Sub