PDFファイルを開き、印刷し、閉じるマクロ

質問

Excel 2003 VBAにて、
PDFファイルを開き、印刷し、閉じるマクロを作りたいと思っています。

Dim AA, AAA

AA = "C:\Program Files\Adobe\Reader 11.0\Reader\AcroRd32.exe C:\Scan\20131101160734050_001.pdf"
AAA = Shell(AA, vbNormalFocus)

にて、PDFファイルを開くことは出来ました。
このPDFファイルを、「印刷し、閉じる」ためには、
このPDFファイルを指定する必要があると思いますが、
その構文が判りません。
知っている方、教えて下さい。

回答No.4

mitarashi · ベストアンサー

#3です。
WShell.Execを使うと閉じる事ができる様ですが、色々と気難しくて苦労しました。
まず、なぜかAdobe Reader/Acrobatのフルパスを与えないと、ファイルがみつからないとゴネます。

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub test()
printPdf2 GetDesktopPath & "\test.pdf", "DocuWorks Printer", "DocuWorks Printer Driver"
' printPdf2 GetDesktopPath & "\test.pdf"
End Sub

Sub printPdf2(pdfDocument As String, Optional printerName As Variant, Optional printerDriver As Variant)
Dim cmdLine As String
Dim WShell As Object
Dim oExec As Object
'ここは調整の必要がありそう
Const waitTime As Long = 1000
'Windows7 Home 64bitの場合です
Const pgmFullPath As String = "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe"

Set WShell = CreateObject("WScript.Shell")
If IsMissing(printerName) Or IsMissing(printerDriver) Then
cmdLine = "pgmFullPath /n /s /o /h /t ""pdfFullPath"""
cmdLine = Replace(cmdLine, "pgmFullPath", pgmFullPath)
cmdLine = Replace(cmdLine, "pdfFullPath", pdfDocument)
Else
cmdLine = "pgmFullPath /n /s /o /h /t ""pdfFullPath"" ""printerName"" ""printerDriver"""
cmdLine = Replace(cmdLine, "pgmFullPath", pgmFullPath)
cmdLine = Replace(cmdLine, "pdfFullPath", pdfDocument)
cmdLine = Replace(cmdLine, "printerName", printerName)
cmdLine = Replace(cmdLine, "printeDriver", printerDriver)
End If
Debug.Print cmdLine
Set oExec = WShell.exec(cmdLine)
Sleep waitTime
'Windows7Home/64bit環境ではここで実行時エラーが出るので無理矢理先に進めていますが
'Adobe Readerは閉じられる様です
On Error Resume Next
oExec.Terminate
Set WShell = Nothing
End Sub

Private Function GetDesktopPath() As String
Dim wScriptHost As Object, strInitDir As String
Set wScriptHost = CreateObject("Wscript.Shell")
GetDesktopPath = wScriptHost.SpecialFolders("Desktop")
Set wScriptHost = Nothing
End Function

Terminateで原因不明のエラーが出るのでWebを漁っいて下記をみつけました。64bit環境でエラーが出るのはこれも関係しているのでしょうか？少々無理をしている様なので、ご使用時はご注意下さい。
Terminate メソッドは最後の手段としてのみ使用します。これは、アプリケーションによっては適切にクリーンアップできない場合があるためです。通常は、プロセスを途中で中断せず、プロセス自身で実行を終了させるようにします。Terminate メソッドは WM_CLOSE メッセージを使ってプロセスを終了しようとします。これで終了できない場合は、通常のシャットダウン手順を実行せずに、プロセスを強制終了します。
http://msdn.microsoft.com/ja-jp/library/cc364387.aspx

お礼

度重なるご教示ありがとうございました。
やっと完成しました。

お答えいただいたtest()とPrivate Function GetDesktopPath() As Stringの意味が理解できず正直苦しみました。
VBAの参照設定のなかで、
Windows Script Host Object Model
を追加せよとのことなんですよね。
Sleep関数の使い方は以前より知っていたのですぐ理解できました。
完成品を見て頂きたく、記載させてもらいます。

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub PDF()

Dim AA, BB, CC, DD
Dim AAA, BBB

AA = "C:\Program Files\Adobe\Reader 11.0\Reader\AcroRd32.exe /t "
BB = "C:\Scan\MX-4111FN_20131003_162711.pdf"
CC = "RICOH MP C6003 白黒"
DD = AA & """" & BB & """" & " " & """" & CC & """"
Set AAA = CreateObject("WScript.Shell")
Set BBB = AAA.exec(DD)
Sleep 1000
On Error Resume Next
BBB.Terminate
Set BBB = Nothing
Set AAA = Nothing

End Sub

本当にありがとうございました。

回答No.3

mitarashi

このViewの中に同様の質問が二つあるのに、灯台もと暗しというか面白いですね。質問者様のコードに、コマンドラインオプションを追加するだけなのですが、関数化したので使いやすいかもしれません。
プリンター及び同ドライバ名は環境に合わせて下さい。指定しなければWindowsの標準プリンタに出力されます。
Sub test()
printPdf (GetDesktopPath & "\" & "test.pdf")
End Sub

Sub printPdf(pdfFullPath As String)
Dim objWShell As Object
Dim cmdLine As String
Dim printerName As String
Dim driverName As String

printerName = Chr(34) & "DocuWorks Printer" & Chr(34)
driverName = Chr(34) & "DocuWorks Printer Driver" & Chr(34)
Set objWShell = CreateObject("WScript.Shell")
cmdLine = "AcroRd32.exe /n /s /o /h /t " & pdfFullPath & " " & printerName & " " & driverName
objWShell.Run cmdLine, VbNormalFocus, True '連続実行時の誤動作が少ないことを期待して同期動作にしています。
Set objWShell = Nothing
End Sub

'これは試験の便宜上
Private Function GetDesktopPath() As String
Dim wScriptHost As Object, strInitDir As String
Set wScriptHost = CreateObject("Wscript.Shell")
GetDesktopPath = wScriptHost.SpecialFolders("Desktop")
Set wScriptHost = Nothing
End Function

参考URL：

http://pdf-file.nnn2.com/?p=222

お礼

貴重なマクロ構文を教えていただきありがとうございます。
試したところ、印刷まではできましたが
アクロバットリーダー本体が閉じてくれません。

No2の方へのお礼欄に書きましたマクロ「SSS」と同じ状況です。
今一度ご教示をお願いします。

回答No.2

web2525

参照先が繋がっていた
No1回答の
Adobe Reader で PDF ファイルを表示 / 印刷する方法

http://pdf-file.nnn2.com/?p=752http://www.f3.dio …
↓
http://pdf-file.nnn2.com/?p=752
http://www.f3.dion.ne.jp/~element/msaccess/AcTipsAdobeReader.html

です

お礼

2度に渡るご回答ありがとうございます。
色々な関係サイトをご紹介頂き勉強になりました。
Sub SSS()
Dim AA, AAA
AA = "C:\Program Files\Adobe\Reader 11.0\Reader\AcroRd32.exe C:\Scan\MX-4111FN_20131003_162711.pdf"
AAA = Shell(AA, vbNormalFocus)
SendKeys ("^P"), True
SendKeys "{ENTER}"
SendKeys "%{F4}"
End Sub
では、PDFファイルが開くのみで、SendKeysが機能しませんでした。

そこで、知恵を絞りbatファイルを利用することにして、
Sub TTT()
Dim AA, AAA
AA = "START AcroRd32.exe /t ""C:\Scan\MX-4111FN_20131003_162711.pdf"" ""RICOH MP C6003 白黒"" ""50.28.99.211"""
AAA = "C:\XXX.bat"
Open AAA For Output As #5
Print #5, AA
Close #5
AAA = Shell(AAA, vbNormalFocus)
End Sub
を作りました。
印刷まではできましたが、アクロバットリーダー本体を閉じることができません。

いま少し、お知恵を拝借させてください。

回答No.1

web2525

PDFファイルの印刷はReader上で行うので、Excelから直接実行はできません

VBAから実行するにはSendKeysでReaderを操作するのが一番簡単な方法
Readerがアクティブの状態で

SendKeys "^p", True
SendKeys "{ENTER}"

この2つを実行すれば印刷が始まります
SendKeysに関しては下記サイト参照
http://officetanaka.net/excel/vba/statement/SendKeys.htm
http://www.moug.net/tech/exvba/0150016.html

終了動作もReaderがアクティブの状態で

SendKeys "%{F4}"

で終了できます

-----
その他の方法として

Adobe Reader で PDF ファイルを表示 / 印刷する方法

http://pdf-file.nnn2.com/?p=752http://www.f3.dion.ne.jp/~element/msaccess/AcTipsAdobeReader.html

標準モジュール AdobeReaderは
https://app.box.com/shared/jisind0q7l
↑
ココでダウンロードしたエクセルファイルに組み込まれています

私も、はじめ内容がよくわからなかったけど、Reader開かずにVBA上から直接印刷できるなど、理解できると結構便利に使えます