概要
PDFページ上に指定した間隔で罫線を引き、座標も表示します。PDFを座標で操作する時の目安が欲しくて作りました。Acrobat JavaScriptのサンプルとしてもご利用できます。
ページ左下にはXとY方向の矢印も表示します。
ページ右上にはページのXとY方向のサイズも表示します。
Acrobatのグリッド表示に似た機能ですが、PDF上に残すことが出来ます。VBAからAcrobat OLE経由で注釈のAcrobat JavaScriptを実行します。使用する注釈は以下の2つです。
- 線(Line)
- フリーテキスト(FreeText)
サンプル
サンプル内の関数:DrawRuledLinesを読み出します。呼び出し時に設定するのは、以下の4つです。
- sInFilePathIn As String:
処理する入力PDFのフルパス名 - lInPageStart As Long:
処理を開始するページ番号、-1は先頭ページの指定 - lInPageEnd As Long:
処理を終了するページ番号、-1は最終ページの指定 - iLeng As Long:
罫線の間隔
結果は入力PDFファイル名の後に「-RuledLines」を付けて同じフォルダに保存します。
参照設定が2つ必要です。
ダウンロード:sample-DrawRuledLines.xls
001 Option Explicit
002
003
004 Sub Main_Test()
005 Dim bRet As Boolean
006 Dim sInFilePathIn As String
007
008 ' sInFilePathIn = ThisWorkbook.Path & "\test-002.pdf"
009 sInFilePathIn = ThisWorkbook.Path & "\手書きPDF入門-4.pdf"
010 Dim start As Double: start = Timer
011
012 ' bRet = DrawRuledLines(sInFilePathIn, -1, 2, 100)
013 bRet = DrawRuledLines(sInFilePathIn, -1, -1, 100)
014
015 MsgBox "処理時間 = " & Timer - start
016 End Sub
017
018
019 '**************************************************
020 '
021 ' 指定ページに罫線を描く。
022 ' 座標も表示する。
023 '
024 ' Create : 2020/04/14
025 ' Update :
026 ' Vertion : 1.0.0
027
028 ' 引数1 : sInFilePathIn As String (IN)
029 ' 検索するPDFのフルパスdebu
030 '
031 ' 引数2 :lInPageStart As Long (IN)
032 ' 検索の開始ページ
033 ' 先頭ページは1です
034 ' -1は最初から検索
035 '
036 ' 引数3 :lInPageEnd As Long (IN)
037 ' 検索の終了ページ
038 ' -1で最終ページまで検索
039 '
040 ' 引数4 :iLeng As Long (IN)
041 ' 座標を計算する単位
042 '
043 ' 戻り値 : True 正常処理
044 ' False エラー処理 PDFで無い
045 '
046 ' URL : https://pdf-file.nnn2.com/?p=****
047 '
048 ' その他 : 著作権等は主張しません。
049 ' 上記URLにコメントを頂けると嬉しいです。
050 '
051 '**************************************************
052
053 Public Function DrawRuledLines( _
054 ByVal sInFilePathIn As String, _
055 ByVal lInPageStart As Long, _
056 ByVal lInPageEnd As Long, _
057 ByVal iLeng As Long) As Boolean
058
059 On Error GoTo Err_DrawRuledLines:
060
061 Dim start As Double: start = Timer
062
063 '初期値
064 DrawRuledLines = True
065
066 Dim i1 As Long
067 Dim i2 As Long
068 Dim iPageNo As Long
069 Dim iPageCnt As Long
070 Dim iPageStart As Long
071 Dim iPageEnd As Long
072 Dim bRet As Boolean
073
074 Dim sPoints As String
075 Dim sAJS As String
076 Dim sAJS_MG As String
077 Dim sReturn As String
078
079 '罫線の表示
080 Const sAcrobatJavaScript = _
081 "var annot = this.addAnnot({" & _
082 " type: 'Line' ," & _
083 " page: @p ," & _
084 " doCaption: false ," & _
085 " points: [@r] ," & _
086 " strokeColor: @c ," & _
087 "});"
088
089 ' " lock: true ," & _
090
091 '座標の表示
092 Const sAcrobatJavaScript2 = _
093 "var annot = this.addAnnot({" & _
094 " page: @p ," & _
095 " type: 'FreeText' ," & _
096 " textFont: 'Viva-Regular' ," & _
097 " textSize: 10 ," & _
098 " alignment: 'align_left' ," & _
099 " rect: [@r] ," & _
100 " width: 0 ," & _
101 " contents: '@t' ," & _
102 " textColor: @c ," & _
103 " strokeColor: ['T'] ," & _
104 "});"
105
106 ' " lock: true ," & _
107 ' " fillColor: ['T'] ," & _
108
109 '右矢印の表示
110 Const sAcrobatJavaScript3_1 = _
111 "var annot = this.addAnnot({" & _
112 " type: 'Line'," & _
113 " page: @p," & _
114 " doCaption: false," & _
115 " points: [[30,30],[30,60]]," & _
116 " arrowEnd: 'ClosedArrow'," & _
117 "});"
118 '上矢印の表示
119 Const sAcrobatJavaScript3_2 = _
120 "var annot = this.addAnnot({" & _
121 " type: 'Line'," & _
122 " page: @p," & _
123 " doCaption: false," & _
124 " points: [[30,30],[60,30]]," & _
125 " arrowEnd: 'ClosedArrow'," & _
126 "});"
127 '(X)の表示
128 Const sAcrobatJavaScript3_3 = _
129 "var annot = this.addAnnot({" & _
130 " page: @p," & _
131 " type: 'FreeText'," & _
132 " textFont: 'Viva-Regular'," & _
133 " textSize: 6," & _
134 " alignment: 'align_left'," & _
135 " rect: [63,20,88,35]," & _
136 " width: 0 ," & _
137 " contents: '(X)'," & _
138 "});"
139 '(Y)の表示
140 Const sAcrobatJavaScript3_4 = _
141 "var annot = this.addAnnot({" & _
142 " page: @p," & _
143 " type: 'FreeText'," & _
144 " textFont: 'Viva-Regular'," & _
145 " textSize: 6," & _
146 " alignment: 'align_left'," & _
147 " rect: [22,59,37,75]," & _
148 " width: 0 ," & _
149 " contents: '(Y)'," & _
150 "});"
151 '座標の表示サイズ
152 Const PT_X = 60 'X
153 Const PT_Y = 13 'Y
154
155 If Dir$(sInFilePathIn, vbNormal) = "" Then
156 MsgBox sInFilePathIn & vbCrLf & _
157 "ファイルが存在しない。", _
158 vbOKOnly + vbCritical, "実行エラー"
159 DrawRuledLines = False
160 Exit Function
161 End If
162
163 'ページ番号のチェック
164 If lInPageStart = -1 Then
165 ElseIf lInPageStart > 0 Then
166 Else
167 MsgBox "lInPageStart = " & lInPageStart & vbCrLf & _
168 "開始ページ番号の誤り。", _
169 vbOKOnly + vbCritical, "実行の中断"
170 DrawRuledLines = False
171 Exit Function
172 End If
173 'ページ番号のチェック
174 If lInPageEnd = -1 Then
175 ElseIf lInPageEnd > 0 Then
176 If lInPageEnd >= lInPageStart Then
177 Else
178 MsgBox "lInPageEnd = " & lInPageEnd & vbCrLf & _
179 "終了ページ番号の誤り。", _
180 vbOKOnly + vbCritical, "実行の中断"
181 DrawRuledLines = False
182 Exit Function
183 End If
184 Else
185 MsgBox "lInPageEnd = " & lInPageEnd & vbCrLf & _
186 "終了ページ番号の誤り。", _
187 vbOKOnly + vbCritical, "実行の中断"
188 DrawRuledLines = False
189 Exit Function
190 End If
191
192 'Acrobatオブジェクトの定義&作成
193 '※ここのオブジェクトをグローバル変数にしては駄目!
194 ' Acrobat 7,8,9,10,11 の時
195 Dim objAcroApp As New Acrobat.AcroApp
196 Dim objAcroAVDoc As New Acrobat.AcroAVDoc
197 Dim objAcroPDDoc As New Acrobat.AcroPDDoc
198 Dim objAcroPDPage As Acrobat.AcroPDPage
199 Dim objAcroAVPageView As Acrobat.AcroAVPageView
200 Dim objAFormApp As AFORMAUTLib.AFormApp
201 Dim objAFormFields As AFORMAUTLib.Fields
202 Dim objAFormField As AFORMAUTLib.Field
203 Dim objAcroPoint As Acrobat.AcroPoint
204
205 objAcroApp.CloseAllDocs
206 objAcroApp.Hide '稀にデスクトップに表示されるので隠す
207
208 'PDFファイルを開く
209 If objAcroAVDoc.Open(sInFilePathIn, "") = False Then
210 MsgBox "Open出来ません。" & vbCrLf & sInFilePathIn, _
211 vbOKOnly + vbCritical, "実行エラー"
212 DrawRuledLines = False
213 GoTo Skip_DrawRuledLines_END:
214 End If
215
216 Application.Cursor = xlWait 'マウスポインターを砂時計
217 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
218 iPageStart = IIf(lInPageStart = -1, 0, lInPageStart - 1)
219 iPageEnd = IIf(lInPageEnd = -1, objAcroPDDoc.GetNumPages, lInPageEnd) - 1
220
221 Set objAFormApp = CreateObject("AFormAut.App")
222 Set objAFormFields = objAFormApp.Fields
223 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
224
225 Dim iPageX As Long
226 Dim iPageY As Long
227 Dim iX As Long
228 Dim iY As Long
229 Dim iXwk As Long
230 Dim iYwk As Long
231
232 For iPageNo = iPageStart To iPageEnd
233 DoEvents
234 Set objAcroPDPage = objAcroPDDoc.AcquirePage(iPageNo)
235
236 '▼ページサイズを取得する
237 Set objAcroPoint = objAcroPDPage.GetSize
238 With objAcroPoint
239 iPageX = .x
240 iPageY = .y
241 End With
242 iX = Int(iPageX / iLeng)
243 iY = Int(iPageY / iLeng)
244
245 '▼罫線用のAcrobat JavaScriptを作成&実行
246 sAJS_MG = ""
247 '縦の罫線
248 For i1 = 1 To iY
249 'Acrobat JavaScriptの編集
250 sAJS = sAcrobatJavaScript
251 sPoints = "[0," & i1 * iLeng & _
252 "],[" & iPageX & "," & i1 * iLeng & "]"
253 sAJS = Replace(sAJS, "@r", sPoints)
254 sAJS = Replace(sAJS, "@p", iPageNo)
255 sAJS = Replace(sAJS, "@c", "color.green")
256 sAJS_MG = sAJS_MG & sAJS
257 Next i1
258
259 '横の罫線
260 For i1 = 1 To iX
261 'Acrobat JavaScriptの編集
262 sAJS = sAcrobatJavaScript
263 sPoints = "[" & i1 * iLeng & _
264 ",0],[" & i1 * iLeng & "," & iPageY & "]"
265 sAJS = Replace(sAJS, "@r", sPoints)
266 sAJS = Replace(sAJS, "@p", iPageNo)
267 sAJS = Replace(sAJS, "@c", "color.green")
268 sAJS_MG = sAJS_MG & sAJS
269 Next i1
270 'Acrobat JavaScript の実行
271 sReturn = objAFormFields.ExecuteThisJavascript(sAJS_MG)
272
273 '▼座標表示用のAcrobat JavaScriptを作成&実行
274 sAJS_MG = ""
275 For i1 = 0 To iX
276 iXwk = i1 * iLeng
277 For i2 = 0 To iY
278 iYwk = i2 * iLeng
279 sAJS = sAcrobatJavaScript2
280 sPoints = iXwk + 1 & "," & iYwk + 1 & _
281 "," & iXwk + PT_X & "," & iYwk + PT_Y
282 sAJS = Replace(sAJS, "@r", sPoints)
283 sAJS = Replace(sAJS, "@p", iPageNo)
284 sAJS = Replace(sAJS, "@c", "color.blue")
285 If i1 = 0 And i2 = 0 Then
286 sAJS = Replace(sAJS, "@t", "(0,0):(X,Y)")
287 Else
288 sAJS = Replace(sAJS, "@t", _
289 "(" & iXwk & "," & iYwk & ")")
290 End If
291 sAJS_MG = sAJS_MG & sAJS
292 Next i2
293 Next i1
294 '右上隅の座標
295 sAJS = sAcrobatJavaScript2
296 sPoints = iPageX + 1 - PT_X & "," & _
297 iPageY + 1 - PT_Y - 2 & "," & _
298 iPageX & "," & _
299 iPageY - 2
300 sAJS = Replace(sAJS, "@r", sPoints)
301 sAJS = Replace(sAJS, "@p", iPageNo)
302 sAJS = Replace(sAJS, "@c", "color.blue")
303 sAJS = Replace(sAJS, "@t", "(" & iPageX & "," & _
304 iPageY & ")")
305 sAJS_MG = sAJS_MG & sAJS
306 'Acrobat JavaScript の実行
307 sReturn = objAFormFields.ExecuteThisJavascript(sAJS_MG)
308
309 '▼矢印と(X),(Y)の表示
310 sAJS_MG = ""
311 For i1 = 1 To 4
312 Select Case i1
313 Case 1: sAJS = sAcrobatJavaScript3_1
314 Case 2: sAJS = sAcrobatJavaScript3_2
315 Case 3: sAJS = sAcrobatJavaScript3_3
316 Case 4: sAJS = sAcrobatJavaScript3_4
317 End Select
318 sAJS = Replace(sAJS, "@p", iPageNo)
319 sAJS_MG = sAJS_MG & sAJS
320 Next i1
321 'Acrobat JavaScript の実行
322 sReturn = objAFormFields.ExecuteThisJavascript(sAJS_MG)
323
324 Next iPageNo
325
326 'PDFファイルを別名で保存
327 Dim sFilePathOut As String
328 sFilePathOut = Replace(sInFilePathIn, ".pdf", "-RuledLines.pdf")
329 If objAcroPDDoc.Save(1, sFilePathOut) = False Then
330 MsgBox "PDFファイルへ保存出来ませんでした", _
331 vbOKOnly + vbCritical, "実行エラー"
332 End If
333
334 Application.Cursor = xlDefault 'マウスポインターを戻す
335 'PDFファイルを閉じる
336 If objAcroAVDoc.Close(False) = False Then
337 MsgBox "AVDocオブジェクトはClose出来ませんでした", _
338 vbOKOnly + vbCritical, "実行エラー"
339 DrawRuledLines = False
340 End If
341
342 Skip_DrawRuledLines_END:
343
344 On Error Resume Next 'これ以降は強制実行
345
346 Application.Cursor = xlDefault 'マウスポインターを戻す
347 '変更しないで閉じます。
348 bRet = objAcroAVDoc.Close(False)
349 'Acrobatアプリケーションの終了
350 objAcroApp.Hide
351 objAcroApp.Exit
352 'オブジェクトの開放
353 Set objAcroPoint = Nothing
354 Set objAFormFields = Nothing
355 Set objAFormField = Nothing
356 Set objAFormApp = Nothing
357 Set objAcroAVPageView = Nothing
358 Set objAcroPDPage = Nothing
359 Set objAcroPDDoc = Nothing
360 Set objAcroAVDoc = Nothing
361 Set objAcroApp = Nothing
362
363 Debug.Print "Total Time = " & Timer - start & _
364 " PageCnt = " & iPageEnd - iPageStart + 1
365
366 Exit Function
367
368 Err_DrawRuledLines:
369 MsgBox "処理は以下の理由で中断しました。" & vbCrLf & _
370 vbCrLf & Err.Number & vbCrLf & Err.Description, _
371 vbOKOnly + vbCritical, "実行エラー"
372 DrawRuledLines = False
373 GoTo Skip_DrawRuledLines_END:
374 End Function
Highlight:プログラミング言語のソースコードを構文で色分け (GUI編)
実行結果
当ページの概要にある画像が実行結果です。
Acrobat JavaScriptの解説
ここではポイントとなる部分のみを解説します。それ以外は
- JavaScript™ for Acrobat® API Reference Adobe® Acrobat® SDK バージョン 8.0
Acrobat JavaScript の日本語解説書
バージョンは古いが十分に使えます。 - テキストにリンクを追加、削除、リンク数のカウント
を御覧ください。
type プロパティ
注釈のタイプを定義します。(Page=76)
- Text : テキスト注釈
- FreeText : テキストボックス
- Line : 線
- Square : 長方形
- Circle : 楕円
- Polygon : 多角形
- PolyLine : 折れ線
- Highlight : ハイライト
- Underline : 下線
- Squiggly : 波形の注釈マーク
- StrikeOut : 取り消し線
- Stamp : スタンプ注釈
- Caret : ※不明
- Ink : 鉛筆注釈
- FileAttachment : ファイル添付注釈
- Sound : 音声注釈
points
線の始点と終点の座標で表します。配列で [ [ 始点のx 座標 , 始点のy 座標 ] , [ 終点のx 座標 , 終点のy 座標 ] ]と書きます。(Page=65)
例:points: [ [ 30 , 30 ] , [ 30 , 60 ] ]
※ [ ] とカンマの使い方に注意してください。
rect
ページ上の注釈の位置を表します。配列で [ 左下隅のx 座標 , 左下隅のy 座標 , 右上隅のx 座標 , 右上隅のy 座標 ]と書きます。(Page=68)
例:rect: [ 65 , 20 , 90 , 35 ]
※ [ ] とカンマの使い方に注意してください。
strokeColor
注釈の表示色を定義します。値は、transparent、gray、RGB またはCMYK カラーを使用します。テキストボックス注釈の場合、strokeColor は境界線とテキストの色を設定します。カラー配列も使えます。(Page=72)
- 透明 : color.transparent
- 黒 : color.black
- 白 : color.white
- 赤 : color.red
- 緑 : color.green
- 青 : color.blue
- シアン : color.cyan
- マゼンタ : color.magenta
- イエロー : color.yellow
- ダークグレー : color.dkGray
- グレー : color.gray
- ライトグレー:color.ltGray
備考
- 座標の計算以外は大したこと無いロジックです。
参照
- AFormAut : ExecuteThisJavascript メソッド
VBAからAcrobat JavaScriptを実行
何故か、原点が右上となります。
Windows11, Acrobat2020, Excel2019
objAFormFields.Addだと左下が原点になります。