[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『差し込み印刷でレコードごとに保存』（こぶた）
差し込み印刷は一度に大量のデータを印刷出来る、保存出来るが特徴だと思いますが、個人情報や企業機密等の問題があるので、企業ごとに出さなければなりません。 しかしながら、100社以上あるのでレコードの指定をすると、かなりのお手間がかかるので、もし簡単な方法があればご教示願えませんでしょうか。
したいこと
企業名 氏名 番号 を振ったA4サイズの用紙を企業ごとに保存したい。
もし、差し込み印刷以外の方法であれば、そちらもご教示いただけませんでしょうか。
どうぞ、よろしくお願い致します。
−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
追伸：1文書に1レコードなのですが、企業別に保存したいので保存するレコードは2レコードか1レコードです。
(こぶた)
・マクロは全然わからないという場合は無視してください。 ・ゼロからは書けなくても、ちょっとした修正ならできることが前提です。
・100社あるなら会社ごとに100回繰り返しているだけです。 ・エクセルデータは、1行目がフィールド名、A列が会社名としています。 ・予め差込印刷の設定はしてあるもとします。 ・エクセルとワードのファイルは、同じフォルダに置きます。 ・下のマクロをエクセルファイルにコピーして実行します。 ・同じフォルダに、会社名.docxで保存される予定です。
Sub test()
Dim mySht As Worksheet
Dim myRng As Range
Dim myApp As Object
Dim myDoc As Object
Dim i As Long
Dim sRec As Long, eRec As Long
Dim myName As String
Set mySht = ThisWorkbook.Sheets("Sheet1")
mySht.Range("A1").CurrentRegion.Sort Key1:=mySht.Range("A1"), Header:=xlYes
Set myApp = CreateObject("Word.Application")
myApp.Visible = True
Set myDoc = myApp.Documents.Open(ThisWorkbook.Path & "\WordFile.docx")
With myDoc.MailMerge
.OpenDataSource _
Name:=ThisWorkbook.FullName, _
SQLStatement:="SELECT * FROM [" & mySht.Name & "$]"
.SuppressBlankLines = True
.Destination = 0
i = 2
Do While mySht.Cells(i, 1).Value <> ""
sRec = i - 1
Do While mySht.Cells(i, 1).Value = mySht.Cells(i + 1, 1).Value
i = i + 1
Loop
eRec = i - 1
With .DataSource
.FirstRecord = sRec
.LastRecord = eRec
End With
.Execute
myName = ThisWorkbook.Path & "\" & mySht.Cells(i, 1).Value & ".docx"
myApp.ActiveDocument.SaveAs fileName:=myName
myApp.ActiveDocument.Close False
i = i + 1
Loop
End With
myApp.Quit False
Set myDoc = Nothing
Set myApp = Nothing
End Sub
マナ様
せっかくマクロ書いていただきましたが、マクロ全然わかりません。
やはりマクロを動かさなければ出来ないものなのでしょうか。
知識不足で大変申し訳ございません。
(こぶた)
たぶんWordファイルにして残すならマクロを勉強するしかないね。 でも差し込み「印刷」なんだから、データはすでに変更する状態じゃないよね？ PDFで保存したらだめなの？ (1111)
1111様
100件以上あるので、pdfで保存するお手間が大変なので、こちらで教えていただこうと思い書き込みしました。 やはりマクロの知識が必要なのですね。
(こぶた)
ん？手間、大したことないけどな。 まあAdobeのPDFMakerしか知らないけど。
AdobeのPDFMakerが入っていれば、差し込み印刷のツールバーかリボンに（バージョンによって違う) Adobe PDF に変換（or結合）ボタンがあるはず。 それを使って差し込み印刷すると、PDFファイルが一枚一枚できる。 100件あるなら100枚できる。
これには連番が振られており、この順番が差し込み印刷順だから、 ファイル名置き換えソフトでも使ってExcelのデータ上から順の名前に置き換えれば、多分わかりやすい。
あとは好きなファイル同士を結合させて一つにしておわり。
ExcelとWordだけで完結させたかったらがんばってマナさんのマクロを読み解くといいよ。 たくさんのマクロの解説ホームページがあるから。 どうしてもわからない場合は ここがわからない、と部分的に絞って聞いたらきっと教えてもらえるよ。たぶんｗ (1111)
1111様
お忙しい中、ご対応ありがとうございました。
pdf入っていないので出来ませんでした。
マクロ全く理解出来なかったので諦めます。
ありがとうございました。
(こぶた)
1) ワードから実行するマクロです。下記コードをワードファイルにコピペして 使ってください。 2）事前にワードの差し込み印刷の設定はしておいてください。 3) また、エクセルのデータは、「会社名」で並べ替えして保存しなおしておいて ください。
ーーーーーーーここまでが準備です。
4）差し込み印刷用のワードファイルを開き、データを差し込んだ状態にしてくだ さい。 5）その上で、下記マクロを実行します。
Sub test()
Dim myDoc As Document
Dim myPath As String
Dim cnt As Long
Dim i As Long
Dim sRec As Long, eRec As Long
Dim myName As String, myName2 As String
Const myField as String = "会社名" '★実際のフィールド名に変更必要かも
Set myDoc = ActiveDocument
myPath = myDoc.Path
' cnt = myDoc.MailMerge.DataSource.RecordCount
With myDoc.MailMerge.DataSource
.ActiveRecord = wdLastRecord
cnt = .ActiveRecord
End With
i = 1
Do While i <= cnt
sRec = i
With myDoc.MailMerge
With .DataSource
.ActiveRecord = i
myName = .DataFields(myField).Value
If .ActiveRecord <> cnt Then
.ActiveRecord = wdNextRecord
myName2 = .DataFields(myField).Value
Do While myName = myName2
i = i + 1
.ActiveRecord = wdNextRecord
myName2 = .DataFields(myField).Value
Loop
End If
eRec = i
.FirstRecord = sRec
.LastRecord = eRec
End With
.Execute
myName = myPath & "\" & myName & ".docx"
ActiveDocument.SaveAs myName
ActiveDocument.Close
i = i + 1
End With
Loop
Set myDoc = Nothing
End Sub
http://www.hi-ho.ne.jp/tomita/tips/tips_wd_000.html#content_1_3 探せばもっとわかりやすいところがあるかも知れません。エクセルもワードも基本は同じなので、エクセルのマクロの使い方を探して参考にしても良いかも知れません。
マナ様
お世話になります。
お忙しい中、簡単な方法をご教示いただき感謝です。
確認ですが、マナ様が作成してくださったマクロを実行すれば、100件程のデータが会社別にワードで保存されるのでしょうか？ それとも★にある会社名を都度入力してマクロの実行をしなければならないのでしょうか？
どちらにしても、早速トライしてみます。わからなければ、また質問させてください。
ご丁寧にありがとうございました。
(こぶた)
・マクロは1回実行するだけで、会社名ごとに、ワードのファイルが分割されて作成されます。 ・ただし、エクセルデータのほうで、事前に会社名で並べ替えしておかないとだめです。
あと上でPDFにできないとありましたが、ワードは2003以前ですか？それでしたら、
myName = ThisWorkbook.Path & "\" & mySht.Cells(i, 1).Value & ".docx"
の行を、↓のように修正して下さい。最後が docx でなくて doc です。
myName = ThisWorkbook.Path & "\" & mySht.Cells(i, 1).Value & ".doc"
マナ様
お世話になります。 早速、試してみましたが、下記のエラーが出ました。
コンパイルエラー： ユーザー定義型は定義されていません。
マナ様に教えていただいた、★の箇所は下記の通りにしました。
Const myField as String ="受付??","法人・団体名","参加者氏名"
他の箇所は全てコピペしました。
出来の悪い生徒で申し訳ございませんが、ご教示願います。
(こぶた)
１）エクセルにマクロをコピーしていませんか。ワードにコピーしてマクロを実行して下さい。
２）★の行は下記のように修正して下さい。 Const myField as String ="法人・団体名"
３）念のためお使いのワードのバージョンを教えて下さい。
マナ様
エクセルでマクロ動かしていました。 ワードでやってみました。 ★のところも直しました。 出来ました！ ありがとうございました。 とっても助かりました。感謝です。
こぶたさんと同様に
１．差込毎に文書を分けて保存したい
２．文書名を差込データ（氏名）にしたい
という内容で、上記マクロをワード2010差込文書で実行し、うまく行きました。
が、同じことを名前を変えて保存した文書では実行できず、成功した文書に上書き保存で実行していたのですが、繰り返すうちにそれもできなくなってしまいました。
エラーは
実行時エラー5631
差込印刷のメイン文書にデータファイルを差し込むことができません。
データレコードがないかクエリオプションに一致するレコードがありません。
と出て、デバックボタンを押すと、下から７行目の.Executeが黄色く表示されます。
ワードの画面で差込はちゃんと入って→にて全件表示されるのですが、どのように対処すればよいでしょうか。
マクロは、Normal下の標準モジュールNewMacrosにあるようです。
お手数ですが、よろしくお願いします。
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.