質問番号:11162376606
http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q11162376606
下記のフォルダーにPDF形式の図面ファイルを入れてあります。
C:\Users\kojin\Desktop\製造工程\図面\123.pdf 等これら図面をExcelVba にて印刷したいのですが
但しPDFファイルを開かず実行できるのがBestですが
印刷終了後はpdfを閉じるようにしたいと思っております。どなたかご教授頂ければ助かります。
プログラム
Option Explicit ' レジストリ値取得用API Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _ (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _ ByVal samDesired As Long, phkResult As Long) As Long Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _ (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _ lpType As Long, lpData As Any, lpcbData As Long) As Long ' レジストリ値取得用定数 Const KEY_QUERY_VALUE = &H1 Const HKEY_LOCAL_MACHINE = &H80000002 ' PDF印刷用定数 Const PrintOK As Integer = 0 Const NoFile As Integer = -1 Const StatusNG As Integer = -2 Const AdobeReaderNG As Integer = -3 '概要 Yahoo知恵袋 質問番号:Q11162376606 2016.08.02 Sub Main() Dim DirName As String Dim FileName As String Dim Res As Integer ' DirName = "C:\Users\kojin\Desktop\製造工程\図面\" ' FileName = "123.pdf" DirName = "Z:\" FileName = "sample.pdf" Res = PDFPrint(DirName, FileName) If Res = NoFile Then MsgBox "指定されたファイルは存在しません!", vbExclamation + vbOKOnly ElseIf Res = StatusNG Then MsgBox "通常使うプリンタのステータスが取得できません!", vbExclamation + vbOKOnly ElseIf Res = AdobeReaderNG Then MsgBox "Acrobat Readerがインストールされていません!", vbExclamation + vbOKOnly End If End Sub '概要 コマンドラインから指定されたPDFファイルを印刷する ' '引数 DirName : 印刷するPDFファイルのフォルダ名 ' FileName : 印刷するPDFファイル名 ' '返値 PrintOK (0) : 正常終了 ' NoFile(-1) : 指定されたPDFファイルが存在しない ' StatusNG(-2) : プリンタ名、ドライバ名、ポート名のいずれかの情報が取得できない ' AdobeReaderNG(-3) : Adobe Readerがインストールされていない Private Function PDFPrint(DirName As String, FileName As String) As Integer Dim WSH As Object Dim WExec As Object Dim Path As String Dim Result As String Dim PrinterName As String Dim DriverName As String Dim PortName As String Dim AdobeReaderInstallFolder As String Dim CommandCode As String Dim Tmp As Variant Dim lp As Integer ' 指定されたPDFファイルが存在するか? If Right(DirName, 1) <> "\" Then DirName = DirName & "\" End If If Dir(DirName & FileName) = "" Then PDFPrint = NoFile Exit Function End If ' OSのバージョンチェック If InStr(Application.OperatingSystem, "5.01") > 0 Then Path = "C:\Windows\System32\" ' WindowsXP Else Path = "C:\Windows\System32\Printing_Admin_Scripts\ja-JP\" ' Windows Vista以上 End If Set WSH = CreateObject("WScript.Shell") ' 通常使うプリンタ名取得 Set WExec = WSH.exec("cscript " & Path & "prnmngr.vbs -g") Result = WExec.StdOut.ReadAll Tmp = Split(Result, vbCrLf) PrinterName = Split(Tmp(3), ": ")(1) ' ドライバ名・ポート名取得 Set WExec = WSH.exec("cscript " & Path & "prnmngr.vbs -l") Result = WExec.StdOut.ReadAll Tmp = Split(Result, vbCrLf) lp = 0 Do While UBound(Tmp) >= lp If InStr(Tmp(lp), "プリンター名 ") > 0 Then If InStr(Tmp(lp), PrinterName) > 0 Then DriverName = Replace(Tmp(lp + 2), "ドライバー名 ", "") PortName = Replace(Tmp(lp + 3), "ポート名 ", "") Exit Do End If End If lp = lp + 1 Loop ' プリンタのステータスが取得できない If PrinterName = "" Or DriverName = "" Or PortName = "" Then Set WSH = Nothing Set WExec = Nothing PDFPrint = StatusNG Exit Function End If ' Acrobat Reader(Adobe Reader)のインストールパスをレジストリから取得 AdobeReaderInstallFolder = GetRegValue(HKEY_LOCAL_MACHINE, _ "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\AcroRd32.exe", "Path") If AdobeReaderInstallFolder = "" Then Set WSH = Nothing Set WExec = Nothing PDFPrint = AdobeReaderNG Exit Function End If ' PDFファイルを印刷 CommandCode = AdobeReaderInstallFolder & "AcroRd32.exe /t " & DirName & FileName & " " & _ Chr(34) & PrinterName & Chr(34) & " " & Chr(34) & DriverName & Chr(34) & " " & PortName Set WExec = WSH.exec(CommandCode) ' AdobeReaderを閉じる CommandCode = "taskkill /IM AcroRd32.exe" Set WExec = WSH.exec(CommandCode) Set WSH = Nothing Set WExec = Nothing PDFPrint = PrintOK End Function '概要 レジストリの値を取得する ' '引数 lngRootKey : レジストリルートキー ' strSubKey : レジストリサブキー ' strName : 名前 ' '返値 取得したレジストリの値 ' '注釈 「EXCEL VBA:レジストリ情報取得・yuriのIT手帳」(http://blog.livedoor.jp/yorinaga/archives/52016032.html)参照 Function GetRegValue(lngRootKey As Long, strSubKey As String, strName As String) As String Dim lngRet As Long Dim hWnd As Long Dim strValue As String 'ハンドルを開く hWnd = Application.hWnd lngRet = RegOpenKeyEx(lngRootKey, strSubKey, 0, KEY_QUERY_VALUE, hWnd) '受け取り値用のバッファを確保 strValue = String(255, " ") '値を取得 lngRet = RegQueryValueEx(hWnd, strName, 0, 0, ByVal strValue, LenB(strValue)) 'ハンドルを閉じる RegCloseKey hWnd '取得した値から後続のNullを取り除く strValue = Left(strValue, InStr(strValue, vbNullChar) - 1) '取得した値を返り値に設定 GetRegValue = strValue End Function
参考サイト
Windowsのバージョン情報取得
https://www.moug.net/tech/exvba/0150124.html
Windowsの種類を取得する・morg(モーグ)
プリンタの情報(既定のプリンタ名、ドライバ名、ポート名)
http://www.town.yakumo.lg.jp/modules/information_blog/details.php?bid=871
プリンタの情報取得・北海道八雲町情報政策課ブログ
https://msdn.microsoft.com/ja-jp/library/cc772768(v=ws.10).aspx
Prnmngr.vbs・マイクロソフト
Prnmngr.vbs
プリンタまたはプリンタ接続を追加、削除、および一覧表示します。また、既定のプリンタを設定および表示します。パラメータを付けずに prnmngr.vbs を実行すると、prnmngr.vbs コマンドのコマンド ライン ヘルプが表示されます。
Adobe Readerのプロパティ取得及び印刷(Adobe Readerのインストールフォルダ)
https://helpx.adobe.com/jp/acrobat/kb/511265.html
レジストリから Acrobat・Adobe Reader のバージョン情報を得る方法について(別解)・Adobe
http://pdf-file.nnn2.com/?p=222
WINDOWS のコマンドラインから ACROBAT や ADOBE READER を使用して印刷する方法・VBA(Excel)からAcrobat経由でPDFをプログラミング操作(OLE:IAC)する
http://blog.livedoor.jp/yorinaga/archives/52016032.html
EXCEL VBA:レジストリ情報取得・yuriのIT手帳