ワ ード 差込印刷 グループ毎に保存 マクロ

質問

お世話になります。

エクセルで、次のようなデータを作り、ワード差込で レター を５つ作成します。

各レターの編集で、D列の第1～第3グループ毎まとめてワードで 文書保存したい
ため、「最初のレコードと最後のレコー ド」を指定 して、ワードファイルを保存する
作業を３回行っております。

これを、マクロでD列を指定して、自動で保存するよ うにはできるものでしょうか。

第1グループには、佐藤さん田中さんの2枚つながったワード文書で保存、
第2グループには、菊地さん武田さんの2枚つながったワード文書で保存、
第3グループには、今井さん1枚のワードで保存

それぞれ、ファイル名はそれらのグループ名で保存できたら とても助かります。

　　　　A 　　　　B　　　　 C　　　　 D
1 　コード　　 氏名　　 金額 　グループ
2　　 001　　 佐藤　　　 10　　　 第１
3　　 002　　 田中　　　 50　　　 第１
4　　 003　　 菊池　　　 20　　　 第2
5　　 004　　 武田　　　 30　　　 第2
6　　 005　　 今井　　 　25　　　 第3

以上、どなたかお知恵を拝借できませんでしょうか。
どうかよろしくお願い致します。

回答No.1

MSZ006 · ベストアンサー

やろうとしていることと違っているかもしれませんがご参考までに。

----------
エクセルのシートはご質問にあるとおりのフォーマットで作成。
エクセルファイルと同じフォルダ内に「雛形.doc」として文書の雛形を作成しておく。
雛形内には、
xxx
999
000
ggg

という文字列があり、エクセルの明細行ごとに、

xxx →氏名
999 →コード
000 →金額
ggg →グループ
に置き換わります。

出来上がった文書はグループごとに「グループ名.xls」で保存されます。
------------

Sub SaveFiles()
Dim wdObj As New Word.Application
Dim wdDoc As Word.Document
Dim wordPrototypeFile As String
Dim wordFile As String
Dim i As Long
Dim lastrow As Long
Dim newFlag As Boolean

wordPrototypeFile = ThisWorkbook.Path & "\雛形.doc" '雛形のファイル
lastrow = Range("A1").End(xlDown).Row

wdObj.Visible = True
wdObj.Documents.Open Filename:=wordPrototypeFile, ReadOnly:=True '読み取り専用で開く
wdObj.ActiveDocument.Content.Copy 'クリップボードにコピー
wdObj.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges '保存しないで閉じる

For i = 2 To lastrow
wordFile = ThisWorkbook.Path & "\" & Cells(i, 4).Value & ".doc" '編集するファイルを「グループ」で判定
If Dir(wordFile) = "" Then 'ファイルが存在しない場合は新規作成
wdObj.Documents.Add
newFlag = True
Else
wdObj.Documents.Open wordFile 'ファイルを開く
newFlag = False
End If

If newFlag = False Then '既存ファイルの場合は文末に改ページを挿入
wdObj.ActiveDocument.Characters.Last.Select
wdObj.Selection.InsertBreak Type:=wdPageBreak
End If
wdObj.ActiveDocument.Characters.Last.Select '文末にカーソル移動、雛形を貼り付け
wdObj.Selection.PasteAndFormat (wdPasteDefault)
wdObj.ActiveDocument.Content.Select '文書全体を検索範囲にする

With wdObj.Selection.Find '雛形上の999をコードに置き換える
.Text = "999"
.Replacement.Text = Cells(i, 1)
.Forward = True
.Execute , , , , , , , , , , wdReplaceAll
End With

With wdObj.Selection.Find '雛形上のxxxを氏名に置き換える
.Text = "xxx"
.Replacement.Text = Cells(i, 2)
.Forward = True
.Execute , , , , , , , , , , wdReplaceAll
End With

With wdObj.Selection.Find '雛形上の000を金額に置き換える
.Text = "000"
.Replacement.Text = Cells(i, 3)
.Forward = True
.Execute , , , , , , , , , , wdReplaceAll
End With

With wdObj.Selection.Find '雛形上のgggをグループに置き換える
.Text = "ggg"
.Replacement.Text = Cells(i, 4)
.Forward = True
.Execute , , , , , , , , , , wdReplaceAll
End With

If newFlag = True Then '新規ファイルの場合は名前をつけて保存して閉じる
wdObj.ActiveDocument.SaveAs Filename:=wordFile
wdObj.ActiveDocument.Close
Else '既存ファイルの場合は保存して閉じる
wdObj.ActiveDocument.Close SaveChanges:=wdSaveChanges
End If
Next
wdObj.Quit
End Sub

以上です。的外れだったらすみません。

お礼

MSZ006様

早速のお答えありがとうございます。

ご教示の通り入力したのですが、2行目で構文エラーが生じてしまいました。
また、
「出来上がった文書はグループごとに「グループ 名.xls」で保存されます。」とのことでしたが、これはexcelでなくwordでそれぞれ保存したいと思っております。

図々しく申し訳ございませんが、どうか引き続きお助けいただけますでしょうか。よろしくお願いいたします。

回答No.7

enunokokoro

No.3の回答者です。

お礼に書かれた追加については、私なりに考えてみました。
グループの列のデータが提示したものだと、私が提示したマクロ
を書き換えても無理かと思います。
「店のコード＋店名」の形式だと、単純な「第1」のような形式と
違って、変数名Gnameに対応できないものなので。
ですから、「グループ」の列以外に単純なグループ名（第1など）
の列はできないのでしょうか？

Excel側で単純にできる列を用意ができれば、それをもとにして
マクロで可能になります。また、差し込みフィールドを使って、
IFフィールドの対象にすることもしやすくなります。
差し込み印刷をするためのデータソースは、できるだけ単純で、
シンプルなもののほうが楽に作業ができますし、応用もしやすく
なります。

Excelは関数などを使ったり、作業列を使うなりして、データを
工夫しやすいソフトだと思っています。
データソースをいじることができないなら、別ブックやシートに
差し込み専用のもの用意して作業することをお勧めします。

「店のコード」と「店名」の列を分けるなどをしても、マクロが
不得意な私には、追加アドバイスができるほどのスキルはなく、
希望に添えませんので、新規質問をするなどして、他の回答者が
アドバイスをしてもらえるようにしたほうがよいかと思います。

お礼

enunokokoro様

ご確認ありがとうございます。

「0000＆お店名」　について分けての対応ということで承知致しました。

各ワードのファイル名にお店名がでるようにしたかったため、このような名前にしておりました。

一旦コードとお店名を分けて作業してみたいと思います。

この度は大変お世話になりました。
ご回答頂き感謝申し上げます。
また何かの機会にお知恵を拝借できたら幸いです。
その際には、どうぞよろしくお願い致します。

回答No.6

MSZ006

MSZ006です。
解決されて何よりです。

一点補足です。
雛形内の文字列ですが、金額の箇所が"000"としてありますが、、置き換える金額が1000等、"000"が含まれる場合に誤動作してしまうことがあります。
"000"ではなくて別の、通常現れ得ないような文字列にしたほうがよかったと、ふと思いました。（他の項目についても同様です）
（文字列を変更した場合はそれに合わせてコーディングも変更してください。）

お礼

MSZ006様

文字列変更の件ありがとうございます。

作業時にそのように気を付けたいと思います。

回答No.5

MSZ006

#4です。

＞コンパイルエラー
＞ユーザー定義型は定義されておりません。
＞とでます。
綴りが間違っている（タイプミス）のときに出ることが多いですので、

２行目、
Dim wdObj As New Word.Application

タイプミスがないか、もう一度ご確認をお願いします。

それから先ほど解答しました、VBエディタ画面の「ツール→参照設定」で、
「Microsoft Word 11.0 Object Library」にチェックが入っているか再度ご確認をお願いします。
似たような名前で、「Microsoft Office 11.0 Object Library」というものにすでにチェックが入っていると思いますが、
これではなく、「Microsoft Word 11.0 Object Library」ですのでご確認をお願いします。

お礼

大変失礼いたしました。

ご想像の通り、よく似たチェックボックスと勘違いをしてしまってました。

無事に作業が出来ました！

もう一つのご回答頂いております方法も良さそうなので、両方試してみたいと思います。

全くの初心者に対し親切でご丁寧なご指導を頂きましたことに感謝申し上げます。

また機会がございまいましたら、どうかよろしくお願い致します。

回答No.4

MSZ006

MSZ006です。

私もword2003/excel2003を使っているのですが・・・何でしょうね。

もしかしたらword文書のほうにマクロを記述されていますか？
私の解答の方法はエクセルシートのほうにマクロを記述する方法となっています。

補足

MSZ006　様

引き続きありがとうございます。
エクセルの方へ記述して試しております。

出てくるエラーは、
コンパイルエラー
ユーザー定義型は定義されておりません。
とでます。

okを押すと、
1行目　Sub SaveFiles()　が黄色くなり、
2行目　wdObj As New Word.Application　が白抜き文字の範囲選択された状態となります。

このようなご報告で伝わりますでしょうか・・・。

どうぞよろしくお願い致します。

回答No.3

enunokokoro

ExcelのマクロでWordの差し込み印刷を制御したいのでしょうか？

差し込んだWord文書に登録して利用するなら、以下のマクロでも
可能かと思います。
マクロは得意でないので、記録マクロから編集したものですが。
（Word2003以前を対象にしています）

Sub MailMerge_DataSource_Query()

Dim Gname As String
Dim Fname As String
Dim i As Long

' ここで指定範囲「第1」などの最初と最後を指定
For i = 1 To 3
　Gname = "第" & i

' クエリでグループ名を指定したままだと新しい指定が無効になる
' 場合があるので、データソースを再設定して対応。
　ActiveDocument.MailMerge.OpenDataSource Name:= _
"データファイルへのパス\ブック名.xls", _
　SQLStatement:="SELECT * FROM `シート名$`"

' OLE DB形式で設定済みのシート名とレコード名とクエリ
ActiveDocument.MailMerge.DataSource.QueryString = _
　"SELECT * FROM `シート名$` WHERE `グループ` = '" & Gname & "'"

' 新規文書への差し込み
　With ActiveDocument.MailMerge
　　.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=True
End With

　Fname = Gname & ".doc"
' ファイル名を指定
ActiveDocument.SaveAs FileName:=Fname
ActiveDocument.Close

Next i

End Sub

お礼

enunokokoroさま

ご回答りがとうございます。

出来ました!

恐れ入りますが追加でご質問させてください。

グループの列へはexcelにおいてソートかける都合から次のような名前を付しております。

0001東京支店
0002大阪支店
0003福岡支店
1001新宿営業所
1002札幌営業所

このような場合、どのように書き換えたら宜しいでしょうか。
基本的なことをわかっておらず申し訳ございませんが、どうか宜しくお願い致します。

回答No.2

MSZ006

MSZ006です。補足を見ました。

すみません、書き間違えました。保存先は「グループ名.doc」です。

あと、大事なことを忘れていました。
VisualBasicEditorの画面で、メニューバーの「ツール」→「参照設定」で、
「Microsoft Word 11.0 Object Liblary」にチェックを入れてください。
（11.0のところは環境によっては違う数字かもしれません）

お礼

チェックは入っているのですが、同様のエラーが生じてしまいます。
当方ワードエクセルともに２００３を利用しております。

その他ご指導のことは行ったつもりなのですが・・・。

最新のワード等利用しないと動かないものでしょうか。
無知で申し訳ないです。