Excel2003プリンター指定してPDF作成

シート名【データ】のセル【AF5】 に
シート名【製造番号】のB列の値を割り当てて、1部ずつ印刷しています。
コマンドボタンは、【製造番号】シートに設置しています。

Private Sub CommandButton1_Click()
Dim i As Long
Dim ws As Worksheet
Set ws = Worksheets("データ")
For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
ws.Cells(5, "AF") = Cells(i, 2)
ws.PrintOut
Next i
End Sub


コマンドボタンを増設し、そのコマンドボタンでプリンターを指定してPDF作成を行いたいと思っています。
以下の記述にて【プリンターを指定して印刷】まではなんとかこぎつけました。
指定するプリンターは、AdobePDFです。
このときに作成されるPDFのファイル名を【製造番号】シートのB列の値で保存していきたいのですが、


Private Sub CommandButton2_Click()
Dim i As Long
Dim ws As Worksheet
Set ws = Worksheets("データ")
For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
ws.Cells(5, "AF") = Cells(i, 2)
ws.PrintOut , ActivePrinter:="Adobe PDF"
Next i
End Sub

この状態ですと、Excelのファイル名がPDFのファイル名として適用されます。
しかし、ファイル名は固定されてしまいエラー検出『同一ファイル名があります 等』されずにそのまま上書き保存され続けるため、最終的には一番最後に差し込みされたセルの値でPDFファイルが1つだけ作成されます。

仮想プリンターAdobePDFを指定してPDFを作成する場合、ファイル名を指定することは無理なのでしょうか？

やりたいこととしては
差し込みされる値の数だけPDFファイルを作成する。
これが達成されれば、過程はどんな方法でもいいのですが…

良き方法をご存知の方いらっしゃいましたら、何卒ご教示くださいませ。

よろしくお願い致します。

No.5 回答者： nicotinism 回答日時： 2012/10/24 01:44

ファイルに連番を付けてくれるPDF作成のフリーソフトは無いこともないです。

私の使わせてもらっているPDFCreatorでは連番を自動的に振ってくれます。
この前、最新版（1.50）に代えようと思いましたが
インストール時に、AVG というフリーのアンチ ウィルスソフトを
どうしても一緒にインストールしようとします。回避不可です。
また、忘れてしまいましたがPDF編集ソフトの試用版もインストールされました
邪魔なオマケは即座にコントロールパネルからアンインストールしました。
それでもよろしければ
http://sourceforge.jp/projects/pdfcreator/
（英語版です日本語版は無いですね）
探せば他にも有るかも？です。
でもAcrovat をお持ちなので、敢えて入れるのも・・・と思います。

ダウンロードするなら、PDFCreator-1_4_3_setup.exe
が宜しいかと、前述のモノとは異なるソフトが同梱されてますが
こちらのバージョンではインストールしないようにチェックを外せます。

※インストール開始直後に
『新しいバージョン1.51出ましたよ。こっちにしない？』と聞いてきますが
お断りしましょう。

この回答へのお礼

フリーソフトのご案内まで！ありがとうございます★

ただ、業務で使用しているPCなのでフリーソフトは入れれないのです。。
せっかく教えていただいたのに、すみません。
業務以外でもし何か機会があれば試してみようと思います！

お礼日時：2012/10/24 11:46

No.4 回答者： nicotinism 回答日時： 2012/10/24 01:26

まず、前回の標準モジュールに丸コピペは以下に全て差し替えてください。

'ミリセカンドで停止
Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)

Function FileEnable(ByVal fName As String) As Boolean
'ファイルが使用可なら、True、でなければ Falseを返す。
'エラー発生時もFalse
'メモ帳などのような
'ファイルをロックしないアプリが開いていた場合は機能せず。
'fName にはフルパスで渡すこと
On Error Resume Next
　　Name fName As fName '同名でリネーム試行
　　Select Case Err.Number
　　　　Case 0
　　　　　　FileEnable = True 'エラーでないので多分未使用
　　　　Case Else
　　　　　　Debug.Print Err.Number, Err.Description
　　End Select
End Function


次にコマンドボタン２のクリック時イベントは下記に差し替え

Private Sub CommandButton2_Click()
　　Const srvFolder As String = "\\サーバー名\共有フォルダ名\" 'ここは適宜変更を
　　Dim i As Long, k As Integer
　　Dim ws As Worksheet
　　Dim oFS As Object
　　Dim sName As String　　 '拡張子を除いたファイル名
　　Dim sExtName As String '拡張子付きファイル名
　　Dim newName As String '最終的なファイル名
　　
　　Set oFS = CreateObject("Scripting.FileSystemObject")
　　Set ws = Worksheets("データ")
　　sName = oFS.getBaseName(ThisWorkbook.FullName)
　　sExtName = sName & ".pdf"
　　
　　If oFS.fileExists(srvFolder & sExtName) Then
　　　　MsgBox "同名のファイルが有ります。処理を中止します"
　　　　Exit Sub
　　End If
　　
　　For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
　　　　ws.Cells(5, "AF") = Cells(i, 2)
　　　　ws.PrintOut , ActivePrinter:="Adobe PDF"
　　　　'↑の後で止まるならコメントアウトして下のCall を有効に
　　　　'Call PrintSheet
　　　　
　　　　Do Until oFS.fileExists(srvFolder & sExtName)
　　　　　　Sleep 500
　　　　　　DoEvents
　　　　　　k = k + 1
　　　　　　If k > 10 Then
　　　　　　　　MsgBox "エラーかも知れません"
　　　　　　　　Stop
　　　　　　End If
　　　　Loop
　　　　
　　　　k = 0
　　　　Do Until FileEnable(srvFolder & sExtName)
　　　　　　Sleep 500
　　　　　　DoEvents
　　　　　　k = k + 1
　　　　　　If k > 10 Then
　　　　　　　　MsgBox "エラーかも知れません"
　　　　　　　　Stop
　　　　　　End If
　　　　Loop
　　　　
　　　　newName = Replace(srvFolder & sExtName, sName, sName & "_" & Cells(i, 2).Value)
　　　　
　　　　If oFS.fileExists(srvFolder & sExtName) Then
　　　　　　MsgBox "同名のファイルが有ります。処理を中止します"
　　　　　　Exit Sub
　　　　End If
　　　　
　　　　Name srvFolder & sExtName As newName
　　
　　Next i
　　Set ws = Nothing: Set oFS = Nothing

End Sub

Private Sub PrintSheet()
'不要かも知れないが、上記 ws.PrintOut , ActivePrinter:="pdfcreator" '"Adobe PDF"
'でモジュールの実行が中止される場合に備えてこれも一緒にコピペ
　　Worksheets("データ").PrintOut , ActivePrinter:="Adobe PDF"
End Sub


念のために、Alt + D でコンパイルを行ってエラーが出ないのを確認します。
さらに念のため一旦ファイルを保存してから
製造番号シートのコマンドボタン２を押してみてください。
なお、サーバー名・フォルダ名の変更を忘れずに！
投稿用にタブインデントを全角スペースに変換しています。

この回答への補足

ほんとにありがとうございます！！

全て差替えて実行してみました！
まず、Alt+Ｄでコンパイルエラーは検出されませんでした。
ファイルを保存してからコマンドボタン２で実行してみました。
１つ目の値が差し込みされてPDFファイルを作成した段階で
「同名のファイルが有ります。処理を中止します」と出ました。
「OK」をクリックするしか選択肢がなかったのでクリックしたら処理が終了されました。

ws.PrintOut , ActivePrinter:="Adobe PDF"
　　　　'↑の後で止まるならコメントアウトして下のCall を有効に
　　　　'Call PrintSheet

↑の後で止まったわけではないと思いますが、一応Callを有効にして再度実行してみました。
特に変化なく、「同名のファイルが有ります。処理を中止します」と出ました。

確認ですが、コマンドボタン２にコピペするのは...

Private Sub PrintSheet()
'不要かも知れないが、上記 ws.PrintOut , ActivePrinter:="pdfcreator" '"Adobe PDF"
'でモジュールの実行が中止される場合に備えてこれも一緒にコピペ
　　Worksheets("データ").PrintOut , ActivePrinter:="Adobe PDF"
End Sub

この部分までコピペで良かったですよね？

補足日時：2012/10/24 11:33

この回答へのお礼

補足で書き忘れたので、お礼欄で失礼します。

同名ファイルがあった場合に、処理を中止するように設定ありますが
ここで、処理を中止するのではなく、名前を変更するか確認して
ダイアログを出すようにすることはできませんでしょうか？
そうすれば、手動でファイル名が変更できるので
ひとまず解決できそうな気がします（その場しのぎではありますが...）

お手数をお掛けしますが、何卒ご教示よろしくお願いします。

お礼日時：2012/10/25 09:42

No.3 回答者： nicotinism 回答日時： 2012/10/23 13:29

コピペする場所は、VBEの画面にしておいてメニューの

『挿入』→『標準モジュール』をクリックして現れる窓の中です。

>差込み印刷が完了したあとも、手動でファイルを閉じるまでは開いたままです
『ファイル』が何を指しているのか不明です。

これは、たとえば、ABC.pdf が出力されてその出力結果が画面上に残ったまま
ということですか。
なら、Adobe PDF の設定変更で自動的に閉じる設定はありませんか
無いとなると、私の案は『没』です。

>手動でファイルを閉じるまでは開いたままです
がエクセルファイルの事でしたら問題ありません。

※質問者さんが作成されたオリジナル（私の回答を付け足す前）のファイルは
念のため大事にとっておいてコピーしたものを改造しましょ。

この回答への補足

何度もご丁寧にありがとうございます！
ほんとに感謝です。

「ファイル」という表現は不適切でした。。
開いたままになるファイルはEXCELファイルなので大丈夫そうですね★
出力後のPDFファイルも自動的に閉じられるので問題なさそうです。

標準モジュールにコピペして、イミディエイトウィンドウにてInUse関数の戻り値確認を行いましたら、Trueとなりました。

現在時刻の表示は確認できませんでした。
表示されなかったということではなく、どこに表示されるのかわかりませんでした。。。

標準モジュールにコピペして、コマンドボタン２で実行してみましたが
やはりPDFファイルは１つしか作成されていませんでした。

ここからもう一段階処理があるのでしょうか？

最悪、AdobePDFプリンターを使わなくてもPDFファイルが作成できるのであればそれでも良いのですが
そんな都合のいいことはないですよね？(笑)

補足日時：2012/10/23 14:03

No.2 回答者： nicotinism 回答日時： 2012/10/22 22:58

最初におことわりした様に、Adobe PDF は持っていないのですよ。

なので汎用的に使えるかもしれない案を提示したわけです。
まずは回答できる範囲で。
下記をマルッと標準モジュールにコピペしてください。

'ミリセカンドで停止
Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)

Function InUse(ByVal fName As String) As Boolean
'ファイルが使用中であれば、True、でなければ Falseを返す。
'エラー発生時もFalse
'メモ帳などのような
'ファイルをロックしないアプリが開いていた場合は機能せず。
'fName にはフルパスで渡すこと
On Error Resume Next
Name fName As fName '同名でリネーム試行
Select Case Err.Number
Case 0
InUse = True 'エラーでないので多分未使用
Case Else
msgbox Err.Number & vbcrlf & Err.Description
End Select
End Function

Sub てすと()
Sleep 1000 * 3 '3秒待機
MsgBox Now
End Sub

次にイミディエイトウィンドウで
?inuse("適当なExcel以外のファイル名（PDF）をフルパスでここに") でEnter打ち
でアプリで開いていた場合と、開いていなかった場合でInUse関数の戻り値を確認
また
「てすと」を実行後３秒たってから現在時刻が表示されるのも確認しておいてください。

さて、Adobe PDF で出力した場合には
ファイル名はエクセルのがABC.xlsだった場合に、ABC.pdf になるのでしょうか？
またファイルの保存先のフォルダはマイドキュメントなどに固定（決め打ち）なのか
それともABC.xls のあるフォルダに作成されるのでしょうか？
※PDF出力後に確認の意味でPDF Reader？ が立ち上がってくる設定に
なっている場合は設定を変えてもらわねば私の案の前提条件が崩れてしまいます。没

この回答への補足

更なるご回答ありがとうございます。
AdobePDFをお持ちではないこと、先のご回答にて承知しております。

そしてご承知いただきたいのは、先の補足にて記載させていただきました
【私のマクロに詳しくない】という点です。
詳しくないという書き方に問題がありました。。。
ほとんどマクロを知らない素人なのです。ですので、基本的な記述や用語が
わかりません。
わからなくても、用語については調べればそれなりの解説が出てきますので
ご教示いただいた内容について用語等を調べながら
わからないなりにやってみました。

標準モジュールにコピペということでしたので
おそらくそれであろう場所にコピペしてみました。
すると、以下のエラーメッセージがでました。

【定数、固定長の文字列、配列、ユーザー定義型および Declare ステートメン
トは、オブジェクト モジュールのパブリック メンバとしては使用できません。】

これは、わたしのコピペ場所が間違っているということですよね？

あと、ご質問いただいておりますAdobePDFの出力結果についてですが
ご推測の通り、現状は【ABC.xls】だった場合【ABC.pdf】となります。
ファイルの保存先については、Acrobatの設定で保存先フォルダを固定しており
ます。
(保存先フォルダは、ネットワーク上のフォルダです）
PDF出力後、「PDF Reader？」といったメッセージは出てこないです。

ひとつ質問です。
ファイルが使用中かどうか確認する内容がありますがファイルは差込み印刷が完
了するまでは開かれた状態なので「使用中」ということになると思うのですがどうでしょうか？
（差込み印刷が完了したあとも、手動でファイルを閉じるまでは開いたままです）


やりたいことの再確認です。
コマンドボタン１で実行される内容は、
【製造番号】シート【B列2行目】の値を、
【データ】シート【AF5】セルに割り当てて印刷。
例えば、B2～B11まで値が入っていれば、【データ】シートは10枚印刷されます。

コマンドボタン２で実行したい内容は、
コマンドボタン１の内容をコピーして印刷する際に
AdobePDFプリンターを選択することで
PDFファイルとして出力されるように変更しています。
この出力されるPDFファイルをそれぞれ別の名前で保存したいです。
保存されるファイル名は、指定したセルの値になることが最良ですが
難しいようなのでEXCELファイル名の末尾に1～10と連番を付けたかたちでもいいです。

長々と申し訳ありませんが、ご検討よろしくお願い致します。
また不明な点がございましたら、何なりとお申し付けくださいませ。

補足日時：2012/10/23 11:55

No.1 回答者： nicotinism 回答日時： 2012/10/22 12:42

Adobe PDF は持ち合わせていないので、案だけですが

>ws.PrintOut , ActivePrinter:="Adobe PDF"
の後に
↓
Dir 関数でファイルが出現するまで Loop
（関数の戻り値が<>"" か ファイル名取得)
↓
Adobe PDF の出力が完了するまで Loop
花ちゃん さんの
指定のファイルが使用中かどうかを調べる (015)
http://hanatyan.sakura.ne.jp/vbhlp/excel03.htm
をFunction モジュールにして利用
↓
Name ステートメントでファイル名を【製造番号】シートのB列の値で書き換える
↓
>Next i

Loop 中は、API のSleep 関数で、Sleep 500 とかを入れて置く
http://homepage1.nifty.com/MADIA/vb/API/Sleep.htm

この回答への補足

早速のご回答ありがとうございます。
明記するの忘れていましたが、私、マクロに関しては詳しくないのです(＞人＜;)
質問に記載している内容も、過去に質問させていただいて
作成したものでして…

ご教示いただきました案について、リンク先を閲覧してみましたが
どれをどうしたらいいのかがわかりません( ノω-、)
お手数おかけして申し訳ないのですが、少し詳しくご説明いただけると助かります。

何卒よろしくお願い致します。

補足日時：2012/10/22 13:47