AcroExch.PDDoc: CropPages メソッド

TOP > AcroExch.PDDoc > CropPages      [...]


説明

指定されたページをトリミング(範囲指定で切り取り)します。

トリミング結果が72ポイント(1インチ)未満ならば要求が無視されます。

形式

VARIANT_BOOL CropPages(long nStartPage, 
               long nEndPage,
               short nEvenOrOddPagesOnly,
               LPDISPATCH iAcroRect);

戻り値

  • -1 : 成功。
  • 0 : 失敗。

引数

  1. 第1引数(long nStartPage) :
    処理開始ページ。0が開始ページ。
  2. 第2引数(long nEndPage) :
    処理終了ページ。
  3. 第3引数(short nEvenOrOddPagesOnly) :
    PDFドキュメントの対象範囲
      0:全てのページ
      1:奇数ページのみ
      2:偶数ページのみ
  4. 第4引数(LPDISPATCH iAcroRect) :
    トリミングする範囲を指定したAcroRectオブジェクト

動作するバージョン

VersionAdobe
Acrobat
備考
4-Acrobat 4.0    ※Windows 98SE + Excel 2000
5
-
Acrobat 5.0.5
6
-
Acrobat 6.0.3 Pro
7-Acrobat 7.0.9 Pro
Acrobat 7.1.4 Pro
8OKAcrobat 8.1.2 Pro
9-Acrobat 9.3.2 Extended
10-Acrobat X (10.1.8) Extended
11-Acrobat XI (11.0.04) Extended
  • OK = 動作する。
  • NO = 動作しない。 戻り値が0を返す。
  • - = 未確認。

サンプル:Excel のVBA

説明:Test01.PDFの全体ページを上下左右ともに同じサイズでトリミングし、別名で保存する。

  • F8キーでステップ実行しながら動作確認する。
  • 事前に参照設定をする。
001 Sub AcroExch_PDDoc_CropPages() 002 003 Dim objAcroApp As New Acrobat.AcroApp 004 Dim objAcroAVDoc As New Acrobat.AcroAVDoc 005 Dim objAcroPDDoc As Acrobat.AcroPDDoc 006 Dim objAcroPDPage As Acrobat.AcroPDPage 007 Dim objAcroRect As New Acrobat.AcroRect 008 Dim objAcroPoint As Acrobat.AcroPoint 009 Dim lPageCount As Long 010 Dim lRet As Long 011 012 'アクロバットを起動 013 lRet = objAcroApp.Show 014 'PDFファイルを開いて表示する 015 lRet = objAcroAVDoc.Open("E:\Test01.pdf", "") 016 'PDDocを取得する 017 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc 018 'ページ数を取得する 019 lPageCount = objAcroPDDoc.GetNumPages() 020 '最初のページのページサイズを取得する 021 Set objAcroPDPage = objAcroPDDoc.AcquirePage(0) 022 Set objAcroPoint = objAcroPDPage.GetSize 023 024 '5mmをポイントにした値 025 Const lPointSise As Long = 2.834 * 5 026 'AcroRectオブジェクトにトリミング範囲を設定(上下左右-5mm) 027 objAcroRect.Top = objAcroPoint.y - lPointSise 028 objAcroRect.Left = lPointSise 029 objAcroRect.Right = objAcroPoint.x - lPointSise 030 objAcroRect.bottom = lPointSise 031 'PDF全ページのトリミングを実行 032 lRet = objAcroPDDoc.CropPages( _ 033 0, lPageCount - 1, 0, objAcroRect) 034 035 '別名でPDFファイルを保存する 036 objAcroPDDoc.Save _ 037 (PDSaveFull + PDSaveLinearized + _ 038 PDSaveCollectGarbage), _ 039 "E:\Test01_T.pdf" 040 '現在表示しているPDFファイルを変更無しで閉じる 041 lRet = objAcroAVDoc.Close(1) 042 'Acrobatアプリケーションを終了する。 043 lRet = objAcroApp.Hide 044 lRet = objAcroApp.Exit 045 046 'オブジェクトを強制開放する 047 Set objAcroRect = Nothing 048 Set objAcroPoint = Nothing 049 Set objAcroPDPage = Nothing 050 Set objAcroPDDoc = Nothing 051 Set objAcroAVDoc = Nothing 052 Set objAcroApp = Nothing 053 054 End Sub


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

補足

  • コメントを頂いた「みや」さんの内容をほぼそのまま参考使用させて頂きました。
    この場の借りてお礼を申し上げます。m(_ _)m

動作確認環境

  • WindowsXP Pro(+ SP3) +
    Acrobat 8.1.2 Pro + Office 2003 + MicrosoftUpdate

戻る

「AcroExch.PDDoc: CropPages メソッド」への6件のフィードバック

  1. お世話になります。いつも参考にさせていただいております。ありがとうございます。

    現在,"Acrobat Proのメニューの「ページのトリミング」で余白を削除する"操作と同等のことをVBAから自動化できないかを模索しております。
    具体的には,PDFファイルを開いて,余白を削除して保存といったオペレーションになります。余白の大きさは対象ファイルによって様々です。

    当操作に関して,ご助言いただけると幸いです。よろしくお願いいたします。

  2. suzuさん。初めまして。

    「余白を削除」と言う(スバリ)機能はありません。
    (「余白を削除」はAcrobat v5.0からサポートされた機能です。)

    座標操作で同じように出来ないかとイロイロと思いましたが、計算まで持っていく過程が難しい・・・。
    「余白を削除」チェックボックスをオンにすれば言いだけなのですが、OLEはAcrobatが持っている機能の3%以下の事しか出来ないのが現状です。

    VBAならば、「悪魔の命令」 Sendkeys 命令でメニュー関連を操作(キーボード・エミュレーション)出来ますが、その間はパソコンが使用できない&失敗する場合が有ります。

    もう少し、・・・考えてみます。

  3. 管理人さん
    ご返信ありがとうございます。
    やはり,そうですか。。。
    現実的に難しいのであれば,運用(人手)でカバーしようかと思います。ご調査・ご確認いただき,ありがとうございます。

  4. 現在エクセルvbaでpdfを連続印刷していて、A4サイズPDFの2cm四方の欄を塗りつぶしたいのですが、
    Acrobat 8.1.2 Proをインストールして、AcroExch.PDDoc: CropPages メソッドをほぼ当ページソースの転用で解決が望めるでしょうか?

  5. マヌーサ さん はじめまして。
    質問内容は以下の事でしょうか?

    各ページの上下左右の端2CMを指定の色で塗りつぶします。
    もし、質問内容が上記の図の内容ならばVBAで処理可能です。

    すこし待って頂ければ、ココにVBAサンプルをお見せ出来ます。
    なお、「AcroExch.PDDoc: CropPages メソッド」では出来ません。

  6. 上記の質問内容ならば、以下のVBAで処理可能です。
    行番号 079-081 に色のRGB値をセットして下さい。

    001 Option Explicit
    002 '
    003 ' Excel VBA : Reference setting
    004 '
    005 ' [Adobe Acrobat *.0 Type Library]
    006 ' https://pdf-file.nnn2.com/?p=204
    007 '
    008 ' [AFormAut 1.0 Type Library]
    009 ' https://pdf-file.nnn2.com/?p=753
    010 '
    011 Sub Main()
    012 Dim sInFilePath As String '(In) PDF FilePath
    013 Dim sOutFilePath As String '(Out)PDF FilePath
    014
    015 sInFilePath = "D:\Test.pdf"
    016 Call AddField_2cmAll(sInFilePath, sOutFilePath)
    017
    018 Debug.Print "Print PDF-File=" & sOutFilePath
    019 '..Print.. sOutFilePath
    020 End Sub
    021
    022 Sub AddField_2cmAll( _
    023 ByVal sInFilePath As String, _
    024 ByRef sOutFilePath As String)
    025
    026 On Error GoTo Err_AddField_2cmAll:
    027
    028 Const CON_2CM = 56.68 '2cm=56.68point
    029
    030 Dim iPage As Long
    031 Dim iPageNum As Long
    032 Dim iNo As Long
    033 Dim bRet As Boolean
    034
    035 'Check
    036 If Dir$(sInFilePath, vbNormal) = "" Then
    037 MsgBox sInFilePath & vbCrLf & _
    038 "Not found PDF file。", _
    039 vbOKOnly + vbCritical, "VBA Error(1)"
    040 Exit Sub
    041 End If
    042
    043 'Definition and creation of Acrobat objects
    044 Dim objAcroApp As New Acrobat.AcroApp
    045 Dim objAcroAVDoc As New Acrobat.AcroAVDoc
    046 Dim objAcroPDDoc As New Acrobat.AcroPDDoc
    047 Dim objAcroPDPage As Acrobat.AcroPDPage
    048 Dim objAcroPoint As Acrobat.AcroPoint
    049 Dim objAFormApp As AFORMAUTLib.AFormApp
    050 Dim objAFormFields As AFORMAUTLib.Fields
    051 Dim objAFormField As AFORMAUTLib.Field
    052
    053 '※Here, avoid errors in advance.
    054 '※ [429 ActiveX・・・]
    055 '※Forcibly load Acrobat to memory
    056 objAcroApp.CloseAllDocs
    057
    058 'Open the PDF file to be processed
    059 bRet = objAcroAVDoc.Open(sInFilePath, "")
    060 If bRet = False Then
    061 MsgBox "AVDOC objects cannot be opened.", _
    062 vbOKOnly + vbCritical, "VBA Error(2)"
    063 GoTo Skip_AddField_2cmAll:
    064 End If
    065
    066 Set objAFormApp = CreateObject("AFormAut.App")
    067 Set objAFormFields = objAFormApp.Fields
    068 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
    069 iPageNum = objAcroPDDoc.GetNumPages
    070
    071 'Calculate the RGB value
    072 ' https://pdf-file.nnn2.com/?p=145
    073 Dim sR As Single 'RGB(R, , ) Red
    074 Dim sG As Single 'RGB( ,G, ) Green
    075 Dim sB As Single 'RGB( , ,B) Blue
    076 Dim iP1 As Long 'Coordinate Left
    077 Dim iP2 As Long 'Coordinate Top
    078 Dim iP3 As Long 'Coordinate Right
    079 Dim iP4 As Long 'Coordinate Bottom
    080 Dim i As Long 'Index
    081
    082 'Color:Blue
    083 ' sR = 0 'Red
    084 ' sG = 0 'Green
    085 ' sB = 255 'Blue
    086 'Color:Pink
    087 sR = 255
    088 sG = 0
    089 sB = 255
    090 'Color:Pale blue
    091 ' sR = 51
    092 ' sG = 102
    093 ' sB = 255
    094
    095 iNo = 1
    096 For iPage = 0 To iPageNum - 1
    097
    098 'Get PDF page size
    099 Set objAcroPDPage = objAcroPDDoc.AcquirePage(iPage)
    100 Set objAcroPoint = objAcroPDPage.GetSize
    101
    102 'Add text field to the specified page of PDF
    103 For i = 0 To 3
    104 Select Case i
    105 Case 0 'Top
    106 iP1 = 0
    107 iP2 = objAcroPoint.y
    108 iP3 = objAcroPoint.x
    109 iP4 = objAcroPoint.y - CON_2CM
    110 Case 1 'Left
    111 iP1 = 0
    112 iP2 = objAcroPoint.y
    113 iP3 = CON_2CM
    114 iP4 = 0
    115 Case 2 'Right
    116 iP1 = objAcroPoint.x - CON_2CM
    117 iP2 = objAcroPoint.y
    118 iP3 = objAcroPoint.x
    119 iP4 = 0
    120 Case 3 'Bottom
    121 iP1 = 0
    122 iP2 = CON_2CM
    123 iP3 = objAcroPoint.x
    124 iP4 = 0
    125 End Select
    126
    127 'Adding of text items
    128 Set objAFormField = _
    129 objAFormFields.Add( _
    130 "Text" & iNo, "text", iPage, _
    131 iP1, iP2, iP3, iP4)
    132 iNo = iNo + 1
    133 'Setting of text items
    134 With objAFormField
    135 .SetBackgroundColor "RGB", _
    136 (sR / 255), (sG / 255), (sB / 255), 0
    137 .Value = " " 'The displayed characters
    138 .IsReadOnly = True 'Read only
    139 .IsHidden = False 'Display
    140 End With
    141
    142 'Temporarily release the object.
    143 Set objAFormField = Nothing
    144
    145 Next i
    146 Next
    147
    148 'Save PDF files under a names
    149 sOutFilePath = Replace(sInFilePath, _
    150 ".pdf", "_new.pdf")
    151 bRet = objAcroPDDoc.Save(1, sOutFilePath)
    152 If bRet = False Then
    153 MsgBox "I couldn't save it to a PDF file.", _
    154 vbOKOnly + vbCritical, "VBA Error(3)"
    155 End If
    156
    157 'Close the PDF file
    158 bRet = objAcroAVDoc.Close(False)
    159 If bRet = False Then
    160 MsgBox "The AVDOC object could not be closed.", _
    161 vbOKOnly + vbCritical, "VBA Error(4)"
    162 End If
    163
    164 Skip_AddField_2cmAll:
    165 On Error Resume Next
    166 'Close without changing.
    167 bRet = objAcroAVDoc.Close(False)
    168
    169 'End of Acrobat application
    170 objAcroApp.Hide
    171 objAcroApp.Exit
    172
    173 'Opening of objects
    174 Set objAFormFields = Nothing
    175 Set objAFormApp = Nothing
    176 Set objAcroPDPage = Nothing
    177 Set objAcroPoint = Nothing
    178 Set objAcroPDDoc = Nothing
    179 Set objAcroAVDoc = Nothing
    180 Set objAcroApp = Nothing
    181
    182 ' If bEnd = True Then
    183 ' MsgBox "The processing has ended normally.", _
    184 ' vbOKOnly + vbInformation, "Normal"
    185 ' End If
    186 Exit Sub
    187
    188 Err_AddField_2cmAll:
    189 MsgBox Err.Number & vbCrLf & Err.Description, _
    190 vbOKOnly + vbCritical, "VBA Runtime Error"
    191 GoTo Skip_AddField_2cmAll:
    192 End Sub

    参照
    RGB値の一覧
    AFormAut : Fields.Add メソッド
    AFormAut オブジェクト 一覧
    SetBackgroundColor

コメントを残す

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

CAPTCHA


★ 文章での質問は難しいですよネ。でも、早く解決して、家に帰りたい。


SAMURAI Plugin

コメントをする時は出来れば以下もお願いします。

  • OS名 バージョン
  • Acrobat バージョン
  • ツール(Excel等) バージョン
コメントにサンプルコードを入れる時はコードを全て全角文字列にしてください。コチラで半角に戻します。それでもエラーが回避できない時はコメント下さい。個別に対処します。



お仕事で当サイトを見ている方へ
考え込んだら、ご質問下さい。
一緒に解決策を考えましょう。

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください