PDF上に罫線と座標を表示

TOP > サンプル / 関数 > * [...]

概要

PDFページ上に指定した間隔で罫線を引き、座標も表示します。PDFを座標で操作する時の目安が欲しくて作りました。Acrobat JavaScriptのサンプルとしてもご利用できます。

ページ左下にはXとY方向の矢印も表示します。

ページ右上にはページのXとY方向のサイズも表示します。

Acrobatのグリッド表示に似た機能ですが、PDF上に残すことが出来ます。VBAからAcrobat OLE経由で注釈のAcrobat JavaScriptを実行します。使用する注釈は以下の２つです。

線（Line）
フリーテキスト（FreeText）

サンプル

サンプル内の関数：DrawRuledLinesを読み出します。呼び出し時に設定するのは、以下の４つです。

sInFilePathIn As String：
処理する入力PDFのフルパス名
lInPageStart As Long：
処理を開始するページ番号、－１は先頭ページの指定
lInPageEnd As Long：
処理を終了するページ番号、－１は最終ページの指定
iLeng As Long：
罫線の間隔

結果は入力PDFファイル名の後に「-RuledLines」を付けて同じフォルダに保存します。

参照設定が２つ必要です。

ダウンロード：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 ' 引数１  : sInFilePathIn As String (IN)
029 '           検索するPDFのフルパスdebu
030 '
031 ' 引数２　：lInPageStart As Long    (IN)
032 '           検索の開始ページ
033 '           先頭ページは１です
034 '           -1は最初から検索
035 '
036 ' 引数３　：lInPageEnd As Long      (IN)
037 '           検索の終了ページ
038 '           -1で最終ページまで検索
039 '
040 ' 引数４　：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を実行

PDF

PDF上に罫線と座標を表示

概要

サンプル

実行結果

Acrobat JavaScriptの解説

type　プロパティ

points

rect

strokeColor

備考

参照

コメントを残す

VBA(Excel)からAcrobat経由でPDFをプログラミング操作(OLE:IAC)する

概要

サンプル

実行結果

Acrobat JavaScriptの解説

type プロパティ

points

rect

strokeColor

備考

参照

コメントを残す

VBA(Excel)からAcrobat経由でPDFをプログラミング操作(OLE:IAC)する

type　プロパティ