VBAでPDFファイルをPDF/X-1a:2001形式に変換出力

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

はじめに

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

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

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

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

※Acrobat 8 Pro

１. 処理のポイント

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

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

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

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

2. 処理概要の手順

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

3. 注意事項

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

4. 処理環境および準備

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

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

5. 事前準備

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

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

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

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

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 ' 作成者：https://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編)
　

備考

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

注意点

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

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

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

参考

＜サンプル一覧＞

PDF