ExcelでWordを操作する
Wordで少しずつ異なるたくさんの文書を作成する必要に迫られ、何とかExcelVBAを使って簡単にできないか考えてみました。
あまり使用頻度は高くないかもしれませんが、せっかく作成してみたのでご紹介します。
ExcelでWordを操作する際の準備
ExcelVBAを使ってWordを操作するには参照設定をする必要があります。
VBEの画面で「ツール」→「参照設定」→「Microsoft Word 〇〇 Object Library」にチェックを入れるようにしてください。
スポンサーリンク
今回作成したExcelVBAの概要
今回作成したExcelVBAはWordの差し込み印刷のようなイメージしています。
テンプレートファイルの該当部分の文字を指定したものに置き換え、新たなファイルをどんどん作成していくツールとなっています。
差し込み印刷と異なる部分は2点です。
差し込み印刷の設定・使い方を知らない人でも簡単に使えることをイメージして作成しました。
(何となく自由度が低い気がして、私もあまり詳しく使いこなせていません。)
またWordの場合は通常、単語の位置・文字数・段落などで場所を指定するのですが、Excelのセルと異なり文字を入力すると位置が変わります。
私は下記のように入力項目に<>をつけて挿入する目印にしています。
Wordファイルを差し込み印刷のように作成していくExcelVBAサンプルコード
Excelで記入した表に従って、項目を入力していくExcelVBAコードになります。
項目はいくつあっても入力できる仕様になっています。
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Wordテンプレートに入力()
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(ThisWorkbook.Path & "作成_案内") = False Then
FSO.CreateFolder ThisWorkbook.Path & "作成_案内"
End If
Set FSO = Nothing
Dim wdApp As Object
Set wdApp = CreateObject("Word.Application")
Dim i, k
With wdApp
i = 2
Do Until Cells(i, 1) = ""
k = 1
Do Until Cells(i, k) = ""
.Visible = True
’このファイルと同じフォルダにあるテンプレートファイルを開く
.Documents.Open (ThisWorkbook.Path & "案内_テンプレート.docx")
Sleep 1000 ’①待ち時間を入れないとエラーになる場合があります
With .ActiveDocument.Content.Find
.Text = "<" & Cells(1, k).Text & ">"
.Execute Replace:=wdReplaceAll, replacewith:=Cells(i, k).Text
End With
k = k + 1
Loop
’②Excelセル内の改行をWordの改行に揃える
With .ActiveDocument.Content.Find
.Text = vbLf
.Execute Replace:=wdReplaceAll, replacewith:=vbCr
End With
.Documents(.Documents.Count).SaveAs2 Filename:=ThisWorkbook.Path & "作成_案内案内_" & Replace(Replace(Cells(i, 2), " ", ""), " ", "") & ".docx"
.Documents(.Documents.Count).Close
i = i + 1
Loop
End With
wdApp.Quit
Set wdApp = Nothing
End Sub
Sub Wordテンプレートに入力()
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(ThisWorkbook.Path & "作成_案内") = False Then
FSO.CreateFolder ThisWorkbook.Path & "作成_案内"
End If
Set FSO = Nothing
Dim wdApp As Object
Set wdApp = CreateObject("Word.Application")
Dim i, k
With wdApp
i = 2
Do Until Cells(i, 1) = ""
k = 1
Do Until Cells(i, k) = ""
.Visible = True
’このファイルと同じフォルダにあるテンプレートファイルを開く
.Documents.Open (ThisWorkbook.Path & "案内_テンプレート.docx")
Sleep 1000 ’①待ち時間を入れないとエラーになる場合があります
With .ActiveDocument.Content.Find
.Text = "<" & Cells(1, k).Text & ">"
.Execute Replace:=wdReplaceAll, replacewith:=Cells(i, k).Text
End With
k = k + 1
Loop
’②Excelセル内の改行をWordの改行に揃える
With .ActiveDocument.Content.Find
.Text = vbLf
.Execute Replace:=wdReplaceAll, replacewith:=vbCr
End With
.Documents(.Documents.Count).SaveAs2 Filename:=ThisWorkbook.Path & "作成_案内案内_" & Replace(Replace(Cells(i, 2), " ", ""), " ", "") & ".docx"
.Documents(.Documents.Count).Close
i = i + 1
Loop
End With
wdApp.Quit
Set wdApp = Nothing
End Sub
作成するのに工夫が必要だったポイントは下記2点です。
他のサイトでも書いている人がいましたが、Sleepを入れて待機時間を作ると解決できました。
Excelは「vbLf」、Wordは「vbCr」もしくは「Chr(11)」ですのでこの部分の変更は最後に行う必要があります。
コメント