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

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


はじめに

 

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

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

 


ポイント

  

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

※Acrobat 8 Pro

 

1. 処理のポイント

 

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

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

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

※事前にプリンタを設定しておく。
※レジストリ操作で行う。
 
VBAでPDFファイルをPDF/X-1:a 2001形式に変換出力

 

2. 処理概要の手順

 

  1. レジストリの値をバックアップします。
  2. Windows OS上でのデフォルトプリンタを取得します。
  3. Windows OS上でのデフォルトプリンタを「Adobe PDF」に変更します。
  4. PDFファイルをPDF/X-1a:2001形式で出力する為に関連するレジストリの値を変更します。
  5. PDFファイルをPDF/X-1a:2001形式で1頁単位に分割変換します
  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. 1PDF当たりの処理内容と処理時間等をログファイルで出力する。※当バージョンには無い。
    又はExcelシート上に表示する。
  5. 汎用性を持たせる為にサブルーチン形式を極力取るようにする。
    処理時間に影響する部分はしない。

 

Option Explicit

Private Declare Sub Sleep Lib "kernel32.dll" _
    (ByVal dwMilliseconds As Long)

Private pdfNumPage      As Long     'PDF全頁数
Private strAppPath      As String   'Excel実行フォルダ
Private lFileNo         As Long     'ファイルNO
Private lRet            As Long     '戻り値
Private vRet            As Variant  '戻り値
Private strCMD          As String   'ラインコマンド

'Private Const PDSaveFull = &H1
'Private Const PDSaveLinearized = &H4
'Private Const PDSaveCollectGarbage = &H20

'デフォルトプリンタ変更アプリケーション名 VB6.0
Const CON_APP_CHANGE_PRINTER As String = "ChangePrinter105.exe"
'レジストリ・ファイル
Const CON_BAKREG_FILE = "BackUp.reg.txt"
Const CON_SETREG_FILE = "PDF-X変更-設定.reg.txt"  'WinXP
Const CON_CLRREG_FILE = "PDF-X変更-解除.reg.txt"  'WinXP
Const CON_DEF_PRINTER = "DefPrinter.txt"
'PDF/X-1a:2001に変換されたPDFが入るフォルダ
Const CON_PDFX_FOLDER = "C:¥work¥"  '★

Private objAcroApp  As New Acrobat.AcroApp

'**********************************************************
'
' メイン (サンプル)
'
' 2010/10/25 21:05 (2版)
' 作成者:http://pdf-file.nnn2.com/ サイト管理人
' 機能:PDFファイルをPDF/X-1a:2001に変換する。
' 同時にPDFファイルを1頁単位に連番付与で分割する。
' 備考:ソースで★箇所は環境により変更が必要。
' 1箇所のみ。
' 修正:2010/10/25 ファイルの存在チェック追加(funCheckFile)
' 2010/10/28 ファイルの保存方法を変更
'
'**********************************************************

Public Sub test12()
On Error GoTo ERR_test12:

    If vbOK <> MsgBox("処理を開始しても良いですか?", _
        vbOKCancel + vbQuestion, "確認") Then Exit Sub
        
    Dim strPDFFile(5000)   As String
    Dim i               As Long
    Dim strStart        As String
    Dim strFileData     As String
    Dim strWk1()        As String
    
    strStart = Now()
    '動作アプリケーションパス
    strAppPath = Application.ActiveWorkbook.Path & "¥"
    
    '入力PDFファイル
    For i = LBound(strPDFFile) To UBound(strPDFFile) - 1
        strPDFFile(i) = vbNullString
    Next i
    strPDFFile(0) = "Y:¥test01.pdf"  '2頁
    strPDFFile(1) = "Y:¥Test02.pdf"  '1頁
    strPDFFile(2) = "Y:¥Test_NEW.pdf" '3頁
    strPDFFile(3) = "Y:¥VBJavaScript.pdf"
'    strPDFFile(4) = "Y:¥iac_api_reference.pdf"
    
    '▼現在のレジストリの内容をバックアップ
'    strCMD = "start /wait regedit.exe /e " _
'        & strAppPath & CON_BAKREG_FILE _
'        & " HKEY_CURRENT_USER\Software\Adobe"
    strCMD = "regedit.exe /e " _
        & strAppPath & CON_BAKREG_FILE _
        & " HKEY_CURRENT_USER¥Software¥Adobe"
    vRet = Shell(strCMD, vbHide)
    
    '▼現在のデフォルトプリンタを取得
    If funChangePrinter("/DP") = False Then Exit Sub
    lFileNo = FreeFile
    Open strAppPath & CON_DEF_PRINTER For Input As lFileNo
    Line Input #lFileNo, strFileData
    strWk1 = Split(strFileData, ",")
    Close #lFileNo

    '▼デフォルトプリンタを「Acrobat PDF」に変更
    If funChangePrinter("Adobe PDF") = False Then Exit Sub
    
    '▼Adobe PDFの設定をPDF/Xにする為にレジストリを変更する
    strCMD = "regedit.exe /S " _
        & strAppPath & CON_SETREG_FILE
    vRet = Shell(strCMD, vbHide)
    
    '▼PDFファイルをPDF/X-1a:2001形式で1頁単位に分割変換する
    For i = LBound(strPDFFile) To UBound(strPDFFile) - 1
        If strPDFFile(i) = vbNullString Then Exit For
        lRet = subPut1PageX(strPDFFile(i))
        If lRet = False Then Exit For
    Next i
    
    '▼PDF/Xに関するレジストリを元の状態に戻す
    strCMD = "regedit.exe /S " _
        & strAppPath & CON_CLRREG_FILE
    vRet = Shell(strCMD, vbHide)
    
    '▼Acrobat関連のレジストリを復元する
    strCMD = "regedit.exe /S " _
        & strAppPath & CON_BAKREG_FILE
    vRet = Shell(strCMD, vbHide)
    
    '▼デフォルトプリンタを元に戻す
    If funChangePrinter(strWk1(0)) = False Then Exit Sub

    MsgBox "処理は完了しました。" & vbCrLf & vbCrLf & _
        "開始 " & strStart & vbCrLf & _
        "終了 " & Now(), vbOKOnly, "完了"
    Exit Sub
    
ERR_test12:
    MsgBox "ERROR NO:" & Err.Number & vbCrLf & _
        Err.Description, vbOKOnly, "プログラムの実行エラー(1)"
End Sub

Private Function subPut1PageX(ByVal strFile As String) As Boolean
On Error GoTo Err_subPut1PageX:
    Dim objAcroAVDOC    As New Acrobat.AcroAVDoc
    Dim objAcroPDDOC    As New Acrobat.AcroPDDoc
    Dim objAcroAVDOC_X2 As New Acrobat.AcroAVDoc
    Dim objAcroPDDOC_X2 As New Acrobat.AcroPDDoc
    Dim objJso          As Object

    Dim lRet            As Long
    Dim pdfTotalPage    As Long
    Dim lPageNo         As Long
    Dim strPutFile      As String
    Dim i               As Long
    Dim j               As Long
    Dim strWk2()        As String

    '▼PDFをPDF/X-1a:2001に変換
    lRet = objAcroAVDOC.Open(strFile, "")
    Set objAcroPDDOC = objAcroAVDOC.GetPDDoc()
    pdfTotalPage = objAcroPDDOC.GetNumPages

    'PDFファイルの全頁印刷してPDF/X-1a:2001に変換する。
    lRet = objAcroAVDOC.PrintPagesSilent( _
                0, pdfTotalPage - 1, 2, 0, True)
    lRet = objAcroAVDOC.Close(0)
    lRet = objAcroPDDOC.Close
    Set objAcroPDDOC = Nothing
    Set objAcroAVDOC = Nothing

    '▼PDFを1頁単位に分割保存する
    strWk2 = Split(strFile, "¥")
    j = UBound(strWk2)
    lRet = funCheckFile(CON_PDFX_FOLDER & strWk2(j))

    For lPageNo = 0 To pdfTotalPage - 1

        strPutFile = Left(strWk2(j), Len(strWk2(j)) - 4) & _
                "-" & Format(lPageNo + 1, "0000") & ".pdf"
        FileCopy CON_PDFX_FOLDER & strWk2(j), _
                 CON_PDFX_FOLDER & strPutFile
        lRet = funCheckFile(CON_PDFX_FOLDER & strPutFile)
        lRet = objAcroAVDOC_X2.Open(CON_PDFX_FOLDER & strPutFile, "")
        Set objAcroPDDOC_X2 = objAcroAVDOC_X2.GetPDDoc
       '不要頁の削除
        If pdfTotalPage <> 1 Then
            If lPageNo = 0 Then
                lRet = objAcroPDDOC_X2.DeletePages( _
                        1, pdfTotalPage - 1)
            ElseIf lPageNo = pdfTotalPage - 1 Then
                lRet = objAcroPDDOC_X2.DeletePages( _
                        0, lPageNo - 1)
            Else
                lRet = objAcroPDDOC_X2.DeletePages( _
                        0, lPageNo - 1)
                lRet = objAcroPDDOC_X2.DeletePages( _
                        1, pdfTotalPage - lPageNo - 1)
            End If
        End If
        'ファイル名を変更して保存する ※最適化はされない
        lRet = objAcroPDDOC_X2.Save(0, CON_PDFX_FOLDER & strPutFile)
        'ファイルを閉じる
        lRet = objAcroAVDOC_X2.Close(1)
        
        DoEvents
    Next lPageNo

    '不要なファイルを削除
    Kill CON_PDFX_FOLDER & strWk2(j)

    subPut1PageX = True

Skip:
    On Error Resume Next
    'PDFファイルを閉じる ※念の為に
    lRet = objAcroPDDOC_X2.Close
    lRet = objAcroPDDOC.Close

    'オブジェクトを強制開放する
    Set objAcroPDDOC_X2 = Nothing
    Set objAcroPDDOC = Nothing
    Set objAcroAVDOC = Nothing

    Exit Function
Err_subPut1PageX:
    MsgBox "ERROR NO:" & Err.Number & vbCrLf & _
        Err.Description, vbOKOnly, "プログラムの実行エラー(2)"
    subPut1PageX = False
    GoTo Skip:
End Function

'**********************************************************
'
' funChangePrinter
' ・デフォルトプリンタの情報が入ったファイルの出力
' ・デフォルトプリンタの変更
'
'**********************************************************

Public Function funChangePrinter _
    (ByVal strPrinterName As String) As Boolean

On Error GoTo Err_funChangePrinter:

    Dim strAppPath      As String   'Excelワークブックのフルパス
    Dim verRet                      'Shell関数の戻り値
    Dim strCMD          As String   'コマンドライン
    Dim strLogFile      As String   'LOGファイル名
    Dim strLogFilePath  As String   'フルパス
    Dim strChangePrinter As String  '変更するプリンタ名
    Dim i               As Long     '添え字
    
    funChangePrinter = False
    
    'アプリの監視MAX 60秒
    Const CON_MAX As Long = 60

    '★以下のステートメントは随時変更する必要が有る★
    strChangePrinter = strPrinterName
        
    'Excelワークシートの実行フルパスを取得
    strAppPath = Application.ActiveWorkbook.Path & "\"
    
    '環境の事前チェック
    If Dir(strAppPath & CON_APP_CHANGE_PRINTER) = "" Then
        MsgBox "起動アプリケーション(" & CON_APP_CHANGE_PRINTER & ")が" _
            & "存在しません", _
            vbCrLf & vbCrLf & "処理は中断しました", _
            vbCritical + vbSystemModal, "実行エラー"
        Exit Function
    End If

    '▼「デフォルトプリンタの変更」アプリケーションの起動
    'ログファイルの命名
    Randomize   '乱数の初期化
    strLogFile = Format(Date, "YYYYMMDD") & _
                 Format(Time(), "HHMMSS") & "-" & _
                 Format(Int((9999 * Rnd) + 1), "0000") _
                 & ".log"
    'コマンド内容の作成
    strCMD = strAppPath & CON_APP_CHANGE_PRINTER & " " & _
             strChangePrinter & "," & strLogFile
    'アプリ起動 (非同期的で実行)
    verRet = Shell(strCMD, vbHide)

    '▼起動アプリケーションの完了を監視する
    strLogFilePath = strAppPath & strLogFile
    For i = 1 To CON_MAX
        Sleep 1000
        DoEvents
        If Dir(strLogFilePath) <> "" Then
            '起動アプリケーションの終了を検知した
            Exit For
        End If
    Next i
    If i >= CON_MAX Then
        MsgBox "起動アプリケーションは監視でタイムアウトになりました" & _
            vbCrLf & vbCrLf & "処理を中断します", _
            vbCritical + vbSystemModal, "実行エラー"
        '不要ファイルの削除
        Kill strLogFilePath
        Exit Function
    End If
    
    'テキストファイルの書込み時間分待つ
    Sleep 500
    '不要ファイルの削除
    Kill strLogFilePath

'正常終了
    funChangePrinter = True
    Exit Function

Err_funChangePrinter:
    MsgBox "ERROR NO:" & Err.Number & vbCrLf & _
        Err.Description, vbOKOnly, "実行のプログラムエラー"
End Function

'**********************************************************
'
' funCheckFile
' ・システムの処理時間の加減で出来たてのファイルがOSから
' 認識出来ない場合がある。この処理でタイミングを調整する。
'
'**********************************************************

Private Function funCheckFile(ByVal strFile As String) As Boolean
    Dim i   As Long
    Const CON_MAX = 1000
    
    funCheckFile = True
    Sleep 100
    For i = 1 To CON_MAX
        DoEvents
        If Dir(strFile) <> "" Then
            'ファイルが存在した
            Exit Function
        End If
        Sleep 100
    Next i
    
    '1秒待つ
    Sleep 1000
End Function

 


備考

 

  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 メソッドの第一引数で「0」を使うので、最適化はされません。 

 

注意点

 

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

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

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

 

参考

 

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

 

サンプル一覧

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

CAPTCHA


出来るだけ早く返答する様には心がけています。
が、遅くなる時もありますのでご了承ください。


SAMURAI Plugin