ここから本文です

【VBA】Excel内のデータの数だけwordを作成したい 閲覧いただきありがとうござ...

lov********さん

2019/3/1922:50:48

【VBA】Excel内のデータの数だけwordを作成したい

閲覧いただきありがとうございます。
Excelのデータをwordの指定の場所に反映・作成をデータの数だけ繰り返し行いたいです。

詳しい手順についてですが、帳票.xlsxの一行目『○○店』のデータ(A列:名称、B列:金額、C列:入金日..etc)をテンプレートwordの中にある指定の文字列(名称のデータはword内にある文字列【名称】に、金額のデータは【金額】に...)に置換し、ファイル名を『○○店.docx』に変更して作成する。作成が完了したら二行目の『△△店』も同じような流れで処理...といったような、Excelデータの行の数だけ複数wordを作成するような形です。

データの数だけ同じ一つのテンプレートを用いて、何枚もwordを作成することは可能なのでしょうか。回答お待ちしています。

閲覧数:
38
回答数:
2
お礼:
250枚

違反報告

ベストアンサーに選ばれた回答

プロフィール画像

カテゴリマスター

hot********さん

2019/3/2010:42:34

テンプレートファイルがC:\sample\テンプレート.dotx"
保存フォルダが "C:\sample\"
の場合です。

Sub sample()
Const wdReplaceAll = 2
Dim temp As String
Dim folder As String
Dim file As String
Dim wd As Object
Dim doc As Object
Dim r As Long

temp = "C:\sample\テンプレート.dotx" 'テンプレート
folder = "C:\sample\" '保存フォルダ
Set wd = CreateObject("Word.Application") 'Word
wd.Visible = True 'Word表示
For r = 1 To Range("A" & Rows.Count).End(xlUp).Row '1行目からA列最終章まで
Set doc = wd.Documents.Open(temp) 'テンプレートファイルを開く
With wd.Selection.Find '置換開始
.Text = "【名称】"
.Replacement.Text = Range("A" & r).Value 'A列注目行の値(名称)
.Execute Replace:=wdReplaceAll '置換実行
.Text = "【金額】"
.Replacement.Text = Range("B" & r).Value 'B列注目行の値(名称)
.Execute Replace:=wdReplaceAll '置換実行
End With
doc.SaveAs2 folder & Range("A" & r).Value '名前を付けて保存
Next
doc.Close False 'ファイルを閉じる
wd.Quit 'Word終了
End Sub

この回答は投票によってベストアンサーに選ばれました!

ベストアンサー以外の回答

1〜1件/1件中

プロフィール画像

カテゴリマスター

lin********さん

2019/3/2009:54:25

まず、「テンプレート」となるワードのファイル(ここでは「テンプレート.docx」という想定)の存在するフォルダ内に、「帳票.xlsx」を、「帳票.xlsm」として保存してください(「F12(=名前を付けて保存)」で、ファイル名が表示されている1行下、「∨」をクリックして、「Excel マクロ有効ブック」を選択してください)。

ワード文書内に、「【名称】」が何度出てきても、一括置換していますので、問題ありません。

★★★注意事項★★★
置換する対象となる文言は4行目の「r = Array("【名称】", "【金額】", "【入金日】")」で指定しています。

これは、列「A」=「【名称】」、列「B」=「【金額】」、列「C」=「【入金日】」に対応していますので、そのルールに従って、増やしてください。

問題なのは、エクセルでは、4項目あるのに、ここ(r = Array())で、3項目しか無かった場合は、エラーになりますので、注意してください。

全角半角を区別し、大文字小文字も区別しています。

なお、「.Wrap = 1」の「1」は、ワードの「VBA」では、「wdFindContinue」、「wd.Selection.Find.Execute,,,,,,,,,,2」の「,,,,,,,,,,2」は、同じく「Replace:=wdReplaceAll」のことです。

「帳票.xlsm」の存在するフォルダ(=「テンプレート.docx」の存在するフォルダ)内に、次々と保存して行きます。

Sub Sample()
Dim wd As Object, dc As Object
Dim i As Long, j As Long
r = Array("【名称】", "【金額】", "【入金日】")
Set wd = CreateObject("Word.Application")
wd.Application.DisplayAlerts = False
wd.Visible = False
For i = 1 To Range("A1").End(xlDown).Row
Set dc = wd.Documents.Open(ThisWorkbook.Path & "\テンプレート.docx")
For j = 1 To Range("A" & i).End(xlToRight).Column
wd.Selection.Find.ClearFormatting
wd.Selection.Find.Replacement.ClearFormatting
With wd.Selection.Find
.Text = r(j - 1)
.Replacement.Text = Cells(i, j).Text
.Forward = True
.Wrap = 1
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchByte = True
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
wd.Selection.Find.Execute , , , , , , , , , , 2
Next j
dc.SaveAs ThisWorkbook.Path & "\" & Cells(i, "A").Value & ".docx"
dc.Close
Set dc = Nothing
Next i
wd.Quit
Set wd = Nothing
MsgBox ("Finished!")
End Sub

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる