TOP > AcroExch.PDDoc > CropPages [...]
説明
指定されたページをトリミング(範囲指定で切り取り)します。
トリミング結果が72ポイント(1インチ)未満ならば要求が無視されます。
形式
VARIANT_BOOL CropPages(long nStartPage,
long nEndPage,
short nEvenOrOddPagesOnly,
LPDISPATCH iAcroRect);
戻り値
- －１ : 成功。
- ０ : 失敗。
引数
- 第１引数(long nStartPage) ：
処理開始ページ。０が開始ページ。 - 第２引数(long nEndPage) ：
処理終了ページ。 - 第３引数(short nEvenOrOddPagesOnly) ：
PDFドキュメントの対象範囲
0：全てのページ
1：奇数ページのみ
2：偶数ページのみ - 第４引数(LPDISPATCH iAcroRect) ：
トリミングする範囲を指定したAcroRectオブジェクト
動作するバージョン
| Version | Adobe 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 |
| 8 | OK | Acrobat 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
＜ 戻る ＞
お世話になります。いつも参考にさせていただいております。ありがとうございます。
現在，"Acrobat Proのメニューの「ページのトリミング」で余白を削除する"操作と同等のことをVBAから自動化できないかを模索しております。
具体的には，PDFファイルを開いて，余白を削除して保存といったオペレーションになります。余白の大きさは対象ファイルによって様々です。
当操作に関して，ご助言いただけると幸いです。よろしくお願いいたします。
suzuさん。初めまして。
「余白を削除」と言う(スバリ)機能はありません。
（「余白を削除」はAcrobat v5.0からサポートされた機能です。）
座標操作で同じように出来ないかとイロイロと思いましたが、計算まで持っていく過程が難しい・・・。
「余白を削除」チェックボックスをオンにすれば言いだけなのですが、OLEはAcrobatが持っている機能の３％以下の事しか出来ないのが現状です。
VBAならば、「悪魔の命令」 Sendkeys 命令でメニュー関連を操作(キーボード・エミュレーション)出来ますが、その間はパソコンが使用できない＆失敗する場合が有ります。
もう少し、・・・考えてみます。
管理人さん
ご返信ありがとうございます。
やはり，そうですか。。。
現実的に難しいのであれば，運用（人手）でカバーしようかと思います。ご調査・ご確認いただき，ありがとうございます。
現在ｴｸｾﾙvbaでpdfを連続印刷していて、Ａ４サイズＰＤＦの2cm四方の欄を塗りつぶしたいのですが、
Acrobat 8.1.2 Proをインストールして、AcroExch.PDDoc： CropPages メソッドをほぼ当ページソースの転用で解決が望めるでしょうか？
マヌーサ さん はじめまして。
質問内容は以下の事でしょうか？
各ページの上下左右の端2CMを指定の色で塗りつぶします。
もし、質問内容が上記の図の内容ならばVBAで処理可能です。
すこし待って頂ければ、ココにVBAサンプルをお見せ出来ます。
なお、「AcroExch.PDDoc： CropPages メソッド」では出来ません。
上記の質問内容ならば、以下のVBAで処理可能です。
行番号 079-081 に色のRGB値をセットして下さい。
001 Option Explicit002 '
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