TOP > サンプル / 関数 > VBAでPDFファイルをPDF/X-1a:2001形式に変換出力      [...]

---

はじめに

最初に以下を参照してください。

• PDFをHTMLに変換する方法（Excel VBAサンプル/3）
• 関数：PDFを特定のフォーマットに変換する

上記で解決出来ない時に、コレ以降を参考にしてください。

当記事の内容はかなり古いです。 「印刷の問題点を解決」又はサンプル「印刷設定の変更と復元」を御覧ください。 当記事はこうゆうやり方も過去に有りました、程度の内容で公開を続けます。

---

質問で「PDFファイルをPDF/X-1a:2001形式に出来ないか」をよく頂くのでサンプルを作成する事にします。

※Acrobat 8 Pro

１. 処理のポイント

テスト調査して以下のポイントが判った。

1. 当サイトで紹介しているAcrobat OLE(IAC) ではダイレクトにPDF/X-1a：2001形式へのPDF変換はOS環境が設定されてないと出来ない。
2. デフォルトプリンタが「Adobe PDF」でしかも以下の画面の設定になっていれば、OLEの印刷メソッドで簡単に出来る。
   ※ ↑ 運用でカバーする方法
3. 上記2の状態は期待出来ないのが普通と考えられる。
4. 以下の「Adobe PDF 印刷設定」画面内容がレジストリに保存されている事が判った。
5. 逆の元に戻す方法もレジストリで出来る事が判った。
   RegEdit コマンドで出来る事が判った。

上記のポイントを踏まえて処理VBAロジックを作成すればいい。

※事前にプリンタを設定しておく。
※レジストリ操作で行う。

2. 処理概要の手順

1. レジストリの値をバックアップします。
2. Windows OS上でのデフォルトプリンタを取得します。
3. Windows OS上でのデフォルトプリンタを「Adobe PDF」に変更します。
4. PDFファイルをPDF/X-1a:2001形式で出力する為に関連するレジストリの値を変更します。
5. PDFファイルをPDF/X-1a:2001形式で１頁単位に分割変換します
6. バックアップファイルで変更前の「Adobe PDF」のレジストリの値を元に戻します。
7. Windows OS上でのデフォルトプリンタを「Adobe PDF」から元に戻します。

3. 注意事項

1. 処理中はAcrobatアプリケーションを他で使用しない。
   トラブル回避と処理速度の為です。※予想
2. 他のアプリケーションを稼動させない。
   特に印刷処理はデフォルトプリンタが変更されるので、何らかの影響を受けるかもしれない。
3. CPUとハードディスクへのアクセスが集中する可能性が有る。※予想
4. レジストリの更新はロジックを簡素にする為にWindowsAPIでは無く、コマンドで RegEdit を使う。
   将来的には確実な処理を考えると、WindowsAPIを使う事が望ましい。

4. 処理環境および準備

当サンプルのテスト環境を以下に示す。
環境が少しでも変われば、当サンプルは変更しなければならない箇所が出てくるので注意して欲しい。

1. WindowsXP Pro(+SP3) + Excel 2003 + MicrosoftUpdate
2. Adobe Acrobat Pro v7.1.4
3. Windows のOS付属のレジストリ編集ソフトregedit を使用する
4. Windows のOSにMicrosoft Visual Basic 6.0(+SP5)が動作する関連DLLのインストール
   ※拒否する方がいますが、やり方次第でトラブルは起きません。
5. CPUを酷使する為、出来るだけ高速処理が可能なCPU搭載パソコンを準備する。

5. 事前準備

1. PDFファイルをPDF/X-1a:2001形式で出力する時の詳細な仕様を事前に再確認する。
2. PDFファイルをPDF/X-1a:2001形式で出力する為のレジストリ設定する為のREGファイルを作成する。
   注意：AcrobatがUpdate等によりバージョンが変わるたびに作り直す必要があります。

---

サンプル・プログラム仕様

サンプルのダウンロード：PDFX-OLE-2.zip

1. メインプログラムはExcel とし、Excel のVBAスクリプトで処理を行う。
2. 処理の経過をExcel 上に表示する。 ※当バージョンには無い。
3. サンプルは必要なソフト以外は無い、ピュアなWindows環境でテストする。
4. １PDF当たりの処理内容と処理時間等をログファイルで出力する。※当バージョンには無い。
   又はExcelシート上に表示する。
5. 汎用性を持たせる為にサブルーチン形式を極力取るようにする。
   処理時間に影響する部分はしない。

001 Option Explicit 002 003 Private Declare Sub Sleep Lib "kernel32.dll" _ 004 (ByVal dwMilliseconds As Long) 005 006 Private pdfNumPage As Long 'PDF全頁数 007 Private strAppPath As String 'Excel実行フォルダ 008 Private lFileNo As Long 'ファイルNO 009 Private lRet As Long '戻り値 010 Private vRet As Variant '戻り値 011 Private strCMD As String 'ラインコマンド 012 013 'Private Const PDSaveFull = &H1 014 'Private Const PDSaveLinearized = &H4 015 'Private Const PDSaveCollectGarbage = &H20 016 017 'デフォルトプリンタ変更アプリケーション名 VB6.0 018 Const CON_APP_CHANGE_PRINTER As String = "ChangePrinter105.exe" 019 'レジストリ・ファイル 020 Const CON_BAKREG_FILE = "BackUp.reg.txt" 021 Const CON_SETREG_FILE = "PDF-X変更-設定.reg.txt" 'WinXP 022 Const CON_CLRREG_FILE = "PDF-X変更-解除.reg.txt" 'WinXP 023 Const CON_DEF_PRINTER = "DefPrinter.txt" 024 'PDF/X-1a:2001に変換されたPDFが入るフォルダ 025 Const CON_PDFX_FOLDER = "C:\work\" '★ 026 027 Private objAcroApp As New Acrobat.AcroApp 028 029 '********************************************************** 030 ' 031 ' メイン (サンプル) 032 ' 033 ' 2010/10/25 21:05 (2版) 034 ' 作成者：http://pdf-file.nnn2.com/ サイト管理人 035 ' 機能：PDFファイルをPDF/X-1a:2001に変換する。 036 ' 同時にPDFファイルを１頁単位に連番付与で分割する。 037 ' 備考：ソースで★箇所は環境により変更が必要。 038 ' １箇所のみ。 039 ' 修正：2010/10/25 ファイルの存在チェック追加(funCheckFile) 040 ' 2010/10/28 ファイルの保存方法を変更 041 ' 042 '********************************************************** 043 044 Public Sub test12() 045 On Error GoTo ERR_test12: 046 047 If vbOK <> MsgBox("処理を開始しても良いですか？", _ 048 vbOKCancel + vbQuestion, "確認") Then Exit Sub 049 050 Dim strPDFFile(5000) As String 051 Dim i As Long 052 Dim strStart As String 053 Dim strFileData As String 054 Dim strWk1() As String 055 056 strStart = Now() 057 '動作アプリケーションパス 058 strAppPath = Application.ActiveWorkbook.Path & "\" 059 060 '入力PDFファイル 061 For i = LBound(strPDFFile) To UBound(strPDFFile) - 1 062 strPDFFile(i) = vbNullString 063 Next i 064 strPDFFile(0) = "Y:\test01.pdf" '2頁 065 strPDFFile(1) = "Y:\Test02.pdf" '1頁 066 strPDFFile(2) = "Y:\Test_NEW.pdf" '3頁 067 strPDFFile(3) = "Y:\VBJavaScript.pdf" 068 ' strPDFFile(4) = "Y:\iac_api_reference.pdf" 069 070 '▼現在のレジストリの内容をバックアップ 071 ' strCMD = "start /wait regedit.exe /e " _ 072 ' & strAppPath & CON_BAKREG_FILE _ 073 ' & " HKEY_CURRENT_USER\Software\Adobe" 074 strCMD = "regedit.exe /e " _ 075 & strAppPath & CON_BAKREG_FILE _ 076 & " HKEY_CURRENT_USER\Software\Adobe" 077 vRet = Shell(strCMD, vbHide) 078 079 '▼現在のデフォルトプリンタを取得 080 If funChangePrinter("/DP") = False Then Exit Sub 081 lFileNo = FreeFile 082 Open strAppPath & CON_DEF_PRINTER For Input As lFileNo 083 Line Input #lFileNo, strFileData 084 strWk1 = Split(strFileData, ",") 085 Close #lFileNo 086 087 '▼デフォルトプリンタを「Acrobat PDF」に変更 088 If funChangePrinter("Adobe PDF") = False Then Exit Sub 089 090 '▼Adobe PDFの設定をPDF/Xにする為にレジストリを変更する 091 strCMD = "regedit.exe /S " _ 092 & strAppPath & CON_SETREG_FILE 093 vRet = Shell(strCMD, vbHide) 094 095 '▼PDFファイルをPDF/X-1a:2001形式で１頁単位に分割変換する 096 For i = LBound(strPDFFile) To UBound(strPDFFile) - 1 097 If strPDFFile(i) = vbNullString Then Exit For 098 lRet = subPut1PageX(strPDFFile(i)) 099 If lRet = False Then Exit For 100 Next i 101 102 '▼PDF/Xに関するレジストリを元の状態に戻す 103 strCMD = "regedit.exe /S " _ 104 & strAppPath & CON_CLRREG_FILE 105 vRet = Shell(strCMD, vbHide) 106 107 '▼Acrobat関連のレジストリを復元する 108 strCMD = "regedit.exe /S " _ 109 & strAppPath & CON_BAKREG_FILE 110 vRet = Shell(strCMD, vbHide) 111 112 '▼デフォルトプリンタを元に戻す 113 If funChangePrinter(strWk1(0)) = False Then Exit Sub 114 115 MsgBox "処理は完了しました。" & vbCrLf & vbCrLf & _ 116 "開始 " & strStart & vbCrLf & _ 117 "終了 " & Now(), vbOKOnly, "完了" 118 Exit Sub 119 120 ERR_test12: 121 MsgBox "ERROR NO:" & Err.Number & vbCrLf & _ 122 Err.Description, vbOKOnly, "プログラムの実行エラー(1)" 123 End Sub 124 125 Private Function subPut1PageX(ByVal strFile As String) As Boolean 126 On Error GoTo Err_subPut1PageX: 127 Dim objAcroAVDOC As New Acrobat.AcroAVDoc 128 Dim objAcroPDDOC As New Acrobat.AcroPDDoc 129 Dim objAcroAVDOC_X2 As New Acrobat.AcroAVDoc 130 Dim objAcroPDDOC_X2 As New Acrobat.AcroPDDoc 131 Dim objJso As Object 132 133 Dim lRet As Long 134 Dim pdfTotalPage As Long 135 Dim lPageNo As Long 136 Dim strPutFile As String 137 Dim i As Long 138 Dim j As Long 139 Dim strWk2() As String 140 141 '▼PDFをPDF/X-1a:2001に変換 142 lRet = objAcroAVDOC.Open(strFile, "") 143 Set objAcroPDDOC = objAcroAVDOC.GetPDDoc() 144 pdfTotalPage = objAcroPDDOC.GetNumPages 145 146 'PDFファイルの全頁印刷してPDF/X-1a:2001に変換する。 147 lRet = objAcroAVDOC.PrintPagesSilent( _ 148 0, pdfTotalPage - 1, 2, 0, True) 149 lRet = objAcroAVDOC.Close(0) 150 lRet = objAcroPDDOC.Close 151 Set objAcroPDDOC = Nothing 152 Set objAcroAVDOC = Nothing 153 154 '▼PDFを１頁単位に分割保存する 155 strWk2 = Split(strFile, "\") 156 j = UBound(strWk2) 157 lRet = funCheckFile(CON_PDFX_FOLDER & strWk2(j)) 158 159 For lPageNo = 0 To pdfTotalPage - 1 160 161 strPutFile = Left(strWk2(j), Len(strWk2(j)) - 4) & _ 162 "-" & Format(lPageNo + 1, "0000") & ".pdf" 163 FileCopy CON_PDFX_FOLDER & strWk2(j), _ 164 CON_PDFX_FOLDER & strPutFile 165 lRet = funCheckFile(CON_PDFX_FOLDER & strPutFile) 166 lRet = objAcroAVDOC_X2.Open(CON_PDFX_FOLDER & strPutFile, "") 167 Set objAcroPDDOC_X2 = objAcroAVDOC_X2.GetPDDoc 168 '不要頁の削除 169 If pdfTotalPage <> 1 Then 170 If lPageNo = 0 Then 171 lRet = objAcroPDDOC_X2.DeletePages( _ 172 1, pdfTotalPage - 1) 173 ElseIf lPageNo = pdfTotalPage - 1 Then 174 lRet = objAcroPDDOC_X2.DeletePages( _ 175 0, lPageNo - 1) 176 Else 177 lRet = objAcroPDDOC_X2.DeletePages( _ 178 0, lPageNo - 1) 179 lRet = objAcroPDDOC_X2.DeletePages( _ 180 1, pdfTotalPage - lPageNo - 1) 181 End If 182 End If 183 'ファイル名を変更して保存する ※最適化はされない 184 lRet = objAcroPDDOC_X2.Save(0, CON_PDFX_FOLDER & strPutFile) 185 'ファイルを閉じる 186 lRet = objAcroAVDOC_X2.Close(1) 187 188 DoEvents 189 Next lPageNo 190 191 '不要なファイルを削除 192 Kill CON_PDFX_FOLDER & strWk2(j) 193 194 subPut1PageX = True 195 196 Skip: 197 On Error Resume Next 198 'PDFファイルを閉じる ※念の為に 199 lRet = objAcroPDDOC_X2.Close 200 lRet = objAcroPDDOC.Close 201 202 'オブジェクトを強制開放する 203 Set objAcroPDDOC_X2 = Nothing 204 Set objAcroPDDOC = Nothing 205 Set objAcroAVDOC = Nothing 206 207 Exit Function 208 Err_subPut1PageX: 209 MsgBox "ERROR NO:" & Err.Number & vbCrLf & _ 210 Err.Description, vbOKOnly, "プログラムの実行エラー(2)" 211 subPut1PageX = False 212 GoTo Skip: 213 End Function 214 215 '********************************************************** 216 ' 217 ' funChangePrinter 218 ' ・デフォルトプリンタの情報が入ったファイルの出力 219 ' ・デフォルトプリンタの変更 220 ' 221 '********************************************************** 222 223 Public Function funChangePrinter _ 224 (ByVal strPrinterName As String) As Boolean 225 226 On Error GoTo Err_funChangePrinter: 227 228 Dim strAppPath As String 'Excelワークブックのフルパス 229 Dim verRet 'Shell関数の戻り値 230 Dim strCMD As String 'コマンドライン 231 Dim strLogFile As String 'LOGファイル名 232 Dim strLogFilePath As String 'フルパス 233 Dim strChangePrinter As String '変更するプリンタ名 234 Dim i As Long '添え字 235 236 funChangePrinter = False 237 238 'アプリの監視MAX 60秒 239 Const CON_MAX As Long = 60 240 241 '★以下のステートメントは随時変更する必要が有る★ 242 strChangePrinter = strPrinterName 243 244 'Excelワークシートの実行フルパスを取得 245 strAppPath = Application.ActiveWorkbook.Path & "\" 246 247 '環境の事前チェック 248 If Dir(strAppPath & CON_APP_CHANGE_PRINTER) = "" Then 249 MsgBox "起動アプリケーション(" & CON_APP_CHANGE_PRINTER & ")が" _ 250 & "存在しません", _ 251 vbCrLf & vbCrLf & "処理は中断しました", _ 252 vbCritical + vbSystemModal, "実行エラー" 253 Exit Function 254 End If 255 256 '▼「デフォルトプリンタの変更」アプリケーションの起動 257 'ログファイルの命名 258 Randomize '乱数の初期化 259 strLogFile = Format(Date, "YYYYMMDD") & _ 260 Format(Time(), "HHMMSS") & "-" & _ 261 Format(Int((9999 * Rnd) + 1), "0000") _ 262 & ".log" 263 'コマンド内容の作成 264 strCMD = strAppPath & CON_APP_CHANGE_PRINTER & " " & _ 265 strChangePrinter & "," & strLogFile 266 'アプリ起動 (非同期的で実行) 267 verRet = Shell(strCMD, vbHide) 268 269 '▼起動アプリケーションの完了を監視する 270 strLogFilePath = strAppPath & strLogFile 271 For i = 1 To CON_MAX 272 Sleep 1000 273 DoEvents 274 If Dir(strLogFilePath) <> "" Then 275 '起動アプリケーションの終了を検知した 276 Exit For 277 End If 278 Next i 279 If i >= CON_MAX Then 280 MsgBox "起動アプリケーションは監視でタイムアウトになりました" & _ 281 vbCrLf & vbCrLf & "処理を中断します", _ 282 vbCritical + vbSystemModal, "実行エラー" 283 '不要ファイルの削除 284 Kill strLogFilePath 285 Exit Function 286 End If 287 288 'テキストファイルの書込み時間分待つ 289 Sleep 500 290 '不要ファイルの削除 291 Kill strLogFilePath 292 293 '正常終了 294 funChangePrinter = True 295 Exit Function 296 297 Err_funChangePrinter: 298 MsgBox "ERROR NO:" & Err.Number & vbCrLf & _ 299 Err.Description, vbOKOnly, "実行のプログラムエラー" 300 End Function 301 302 '********************************************************** 303 ' 304 ' funCheckFile 305 ' ・システムの処理時間の加減で出来たてのファイルがOSから 306 ' 認識出来ない場合がある。この処理でタイミングを調整する。 307 ' 308 '********************************************************** 309 310 Private Function funCheckFile(ByVal strFile As String) As Boolean 311 Dim i As Long 312 Const CON_MAX = 1000 313 314 funCheckFile = True 315 Sleep 100 316 For i = 1 To CON_MAX 317 DoEvents 318 If Dir(strFile) <> "" Then 319 'ファイルが存在した 320 Exit Function 321 End If 322 Sleep 100 323 Next i 324 325 '1秒待つ 326 Sleep 1000 327 End Function

　Highlight：プログラミング言語のソースコードを構文で色分け (GUI編)
　

---

備考

1. ロジックを簡単にする為にレジストリの変更処理等はWindows 付属のRegEdit のインポート機能を使って処理する。
2. デフォルトプリンタの変更は、現在Microsoft Visual Basic v6.0(+SP5) のアプリケーションを利用する。
   将来的には専用DLLソフトを作成して、ダイレクトに変更出来るように計画しています。
3. PDFファイルをPDF/X-1a:2001形式に変換するのは非常にCPUを食う。
   処理時間が掛かる為に、進捗状況や結果を表示する為の何らかのロジックを入れる必要がある。
4. PDF/A-1b:2005(CMYK)、PDF/A-1b:2005(RGB)、PDF/X-1a:2001(日本)、PDF/X-3:2002(日本)、プレス品質、高品質印刷、最小ファイルサイズにも、当サンプルは応用可能です。
5. もっと別のやり方で出来るのであればコメントを頂けると有り難いです。
   例 Acrobatアプリケーション以外のソフトを使う。
6. PDDoc.Save メソッドの第一引数で「０」を使うので、最適化はされません。 

注意点

ダウンロードファイルに含まれる以下のファイルはOS毎に作り直す必要があります。

• PDF-X変更-解除.reg.txt
• PDF-X変更-設定.reg.txt

理由はパソコン単位にSID(ユーザー識別番号)が異なるからです。
上記のファイルではそのSIDを使っています。
WindowsAPIにより取得は可能です。

参考

1. Acrobat使用時のレジストリ変化を取得する方法
2. regeditのインポート、エクスポートのコマンドライン」
3. レジストリエディタをコマンドライン操作でレジストリの特定のキーや値を削除する方法
4. Startコマンド

＜ サンプル一覧 ＞