TOP > AcroExch.PDDoc > *
説明
指定されたページをトリミング(範囲指定で切り取り)します。トリミング結果が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オブジェクト
動作するバージョン
| 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キーでステップ実行しながら動作確認します。
Option Explicit
Public Const PDSaveFull = &H1
Public Const PDSaveLinearized = &H4
Public Const PDSaveCollectGarbage = &H20
Sub AcroExch_PDDoc_CropPages()
Dim objAcroApp As New Acrobat.AcroApp
Dim objAcroAVDoc As New Acrobat.AcroAVDoc
Dim objAcroPDDoc As Acrobat.AcroPDDoc
Dim objAcroPDPage As Acrobat.AcroPDPage
Dim objAcroRect As New Acrobat.AcroRect
Dim objAcroPoint As Acrobat.AcroPoint
Dim lPageCount As Long
Dim lRet As Long
'アクロバットを起動
lRet = objAcroApp.Show
'PDFファイルを開いて表示する
lRet = objAcroAVDoc.Open("E:\Test01.pdf", "")
'PDDocを取得する
Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
'ページ数を取得する
lPageCount = objAcroPDDoc.GetNumPages()
'最初のページのページサイズを取得する
Set objAcroPDPage = objAcroPDDoc.AcquirePage(0)
Set objAcroPoint = objAcroPDPage.GetSize
'5mmをポイントにした値
Const lPointSise As Long = 2.834 * 5
'AcroRectオブジェクトにトリミング範囲を設定（上下左右-5mm)
objAcroRect.Top = objAcroPoint.y - lPointSise
objAcroRect.Left = lPointSise
objAcroRect.Right = objAcroPoint.x - lPointSise
objAcroRect.bottom = lPointSise
'PDF全ページのトリミングを実行
lRet = objAcroPDDoc.CropPages( _
0, lPageCount - 1, 0, objAcroRect)
'別名でPDFファイルを保存する
objAcroPDDoc.Save _
(PDSaveFull + PDSaveLinearized + _
PDSaveCollectGarbage), _
"E:\Test01_T.pdf"
'現在表示しているPDFファイルを変更無しで閉じる
lRet = objAcroAVDoc.Close(1)
'Acrobatアプリケーションを終了する。
lRet = objAcroApp.Hide
lRet = objAcroApp.Exit
'オブジェクトを強制開放する
Set objAcroRect = Nothing
Set objAcroPoint = Nothing
Set objAcroPDPage = Nothing
Set objAcroPDDoc = Nothing
Set objAcroAVDoc = Nothing
Set objAcroApp = Nothing
End Sub
補足
- コメントを頂いた「みや」さんの内容をほぼそのまま参考使用させて頂きました。この場の借りてお礼を申し上げます。m(_ _)m
Adobe Web 解説
OLE Automation / AcroExch.PDDoc / CropPages (公式サイト・英語)
動作確認環境
- 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 New 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 objAcroApp.Hide
058
059 'Open the PDF file to be processed
060 bRet = objAcroAVDoc.Open(sInFilePath, "")
061 If bRet = False Then
062 MsgBox "AVDOC objects cannot be opened.", _
063 vbOKOnly + vbCritical, "VBA Error(2)"
064 GoTo Skip_AddField_2cmAll:
065 End If
066
067 ' Set objAFormApp = CreateObject("AFormAut.App")
068 Set objAFormFields = objAFormApp.Fields
069 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
070 iPageNum = objAcroPDDoc.GetNumPages
071
072 'Calculate the RGB value
073 ' https://pdf-file.nnn2.com/?p=145
074 Dim sR As Single 'RGB(R, , ) Red
075 Dim sG As Single 'RGB( ,G, ) Green
076 Dim sB As Single 'RGB( , ,B) Blue
077 Dim iP1 As Long 'Coordinate Left
078 Dim iP2 As Long 'Coordinate Top
079 Dim iP3 As Long 'Coordinate Right
080 Dim iP4 As Long 'Coordinate Bottom
081 Dim i As Long 'Index
082
083 'Color:Blue
084 ' sR = 0 'Red
085 ' sG = 0 'Green
086 ' sB = 255 'Blue
087 'Color:Pink
088 sR = 255
089 sG = 0
090 sB = 255
091 'Color:Pale blue
092 ' sR = 51
093 ' sG = 102
094 ' sB = 255
095
096 iNo = 1
097 For iPage = 0 To iPageNum - 1
098
099 'Get PDF page size
100 Set objAcroPDPage = objAcroPDDoc.AcquirePage(iPage)
101 Set objAcroPoint = objAcroPDPage.GetSize
102
103 'Add text field to the specified page of PDF
104 For i = 0 To 3
105 Select Case i
106 Case 0 'Top
107 iP1 = 0
108 iP2 = objAcroPoint.y
109 iP3 = objAcroPoint.x
110 iP4 = objAcroPoint.y - CON_2CM
111 Case 1 'Left
112 iP1 = 0
113 iP2 = objAcroPoint.y
114 iP3 = CON_2CM
115 iP4 = 0
116 Case 2 'Right
117 iP1 = objAcroPoint.x - CON_2CM
118 iP2 = objAcroPoint.y
119 iP3 = objAcroPoint.x
120 iP4 = 0
121 Case 3 'Bottom
122 iP1 = 0
123 iP2 = CON_2CM
124 iP3 = objAcroPoint.x
125 iP4 = 0
126 End Select
127
128 'Adding of text items
129 Set objAFormField = _
130 objAFormFields.Add( _
131 "Text" & iNo, "text", iPage, _
132 iP1, iP2, iP3, iP4)
133 iNo = iNo + 1
134 'Setting of text items
135 With objAFormField
136 .SetBackgroundColor "RGB", _
137 (sR / 255), (sG / 255), (sB / 255), 0
138 .Value = " " 'The displayed characters
139 .IsReadOnly = True 'Read only
140 .IsHidden = False 'Display
141 End With
142
143 'Temporarily release the object.
144 Set objAFormField = Nothing
145
146 Next i
147 Next
148
149 'Save PDF files under a names
150 sOutFilePath = Replace(sInFilePath, _
151 ".pdf", "_new.pdf")
152 bRet = objAcroPDDoc.Save(1, sOutFilePath)
153 If bRet = False Then
154 MsgBox "I couldn't save it to a PDF file.", _
155 vbOKOnly + vbCritical, "VBA Error(3)"
156 End If
157
158 'Close the PDF file
159 bRet = objAcroAVDoc.Close(False)
160 If bRet = False Then
161 MsgBox "The AVDOC object could not be closed.", _
162 vbOKOnly + vbCritical, "VBA Error(4)"
163 End If
164
165 Skip_AddField_2cmAll:
166 On Error Resume Next
167 'Close without changing.
168 bRet = objAcroAVDoc.Close(False)
169
170 'End of Acrobat application
171 objAcroApp.Hide
172 objAcroApp.Exit
173
174 'Opening of objects
175 Set objAFormFields = Nothing
176 Set objAFormApp = Nothing
177 Set objAcroPDPage = Nothing
178 Set objAcroPoint = Nothing
179 Set objAcroPDDoc = Nothing
180 Set objAcroAVDoc = Nothing
181 Set objAcroApp = Nothing
182
183 ' If bEnd = True Then
184 ' MsgBox "The processing has ended normally.", _
185 ' vbOKOnly + vbInformation, "Normal"
186 ' End If
187 Exit Sub
188
189 Err_AddField_2cmAll:
190 MsgBox Err.Number & vbCrLf & Err.Description, _
191 vbOKOnly + vbCritical, "VBA Runtime Error"
192 GoTo Skip_AddField_2cmAll:
193 End Sub
参照
・RGB値の一覧
・AFormAut : Fields.Add メソッド
・AFormAut オブジェクト 一覧
・SetBackgroundColor