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」を付けて同じフォルダに保存します。参照設定が２つ必要です。

Download：

/p1106-DrawRuledLines.zip ( 38.8 KB )

001 Option Explicit
002 
003 Private msMsg           As String   'メッセージ
004 '   VBA RunTime Error 対応用
005 'Private miErrorNo       As Long     'Err.Number の内容
006 'Private msErrorMsg      As String   'Err.Description の内容
007 
008 Sub Main_Test()
009 
010     '▼メモリ上のAcrobatプロセスを確認する
011     If iCheckAcrobat() > 0 Then
012         msMsg = "Acrobatが動いています。" _
013             & vbCrLf & "処理を中断します。" & vbCrLf _
014             & vbCrLf & "この後でAcrobatの終了を試みます。"
015         MsgBox msMsg, vbCritical, "実行の中断"
016         'Acrobat OLEの終了を試みる
017         Call EndAcrobat
018         Exit Sub
019     End If
020 
021     Dim bRet    As Boolean
022     Dim sInFilePathIn   As String
023     
024     sInFilePathIn = ThisWorkbook.Path & "\test-002.pdf"
025 '    sInFilePathIn = ThisWorkbook.Path & "\手書きPDF入門-4.pdf"
026     Dim start As Double: start = Timer
027     
028 '    bRet = DrawRuledLines(sInFilePathIn, -1, 2, 100)
029     bRet = DrawRuledLines(sInFilePathIn, -1, -1, 100)
030     
031     MsgBox "処理時間 = " & Timer - start
032 End Sub
033 
034 
035 '**************************************************
036 '
037 '       指定ページに罫線を描く。
038 '       座標も表示する。
039 '
040 ' Create  : 2026/03/22
041 ' Update  :
042 ' Vertion : 1.0.1
043 
044 ' 引数１  : sInFilePathIn As String (IN)
045 '           検索するPDFのフルパスdebu
046 '
047 ' 引数２　：lInPageStart As Long    (IN)
048 '           検索の開始ページ
049 '           先頭ページは１です
050 '           -1は最初から検索
051 '
052 ' 引数３　：lInPageEnd As Long      (IN)
053 '           検索の終了ページ
054 '           -1で最終ページまで検索
055 '
056 ' 引数４　：iLeng As Long          (IN)
057 '           座標を計算する単位
058 '
059 ' 戻り値  : True  正常処理
060 '           False エラー処理 PDFで無い
061 '
062 ' URL     : https://pdf-file.nnn2.com/?p=1106
063 '
064 ' その他  : 著作権等は主張しません。
065 '           上記URLにコメントを頂けると嬉しいです。
066 '
067 '**************************************************
068 
069 Public Function DrawRuledLines( _
070     ByVal sInFilePathIn As String, _
071     ByVal lInPageStart As Long, _
072     ByVal lInPageEnd As Long, _
073     ByVal iLeng As Long) As Boolean
074     
075 On Error GoTo Err_DrawRuledLines:
076 
077     Dim start As Double: start = Timer
078 
079     '初期値
080     DrawRuledLines = True
081     
082     Dim i1                  As Long
083     Dim i2                  As Long
084     Dim iPageNo             As Long
085     Dim iPageCnt            As Long
086     Dim iPageStart          As Long
087     Dim iPageEnd            As Long
088     Dim bRet                As Boolean
089     
090     Dim sPoints             As String
091     Dim sAJS                As String
092     Dim sAJS_MG             As String
093     Dim sReturn             As String
094     
095     '罫線の表示
096     Const sAcrobatJavaScript = _
097         "var annot = this.addAnnot({" & _
098         "    type: 'Line' ," & _
099         "    page: @p ," & _
100         "    doCaption: false ," & _
101         "    points: [@r] ," & _
102         "    strokeColor: @c ," & _
103         "});"
104 
105 '        "    lock: true ," & _
106 
107     '座標の表示
108     Const sAcrobatJavaScript2 = _
109         "var annot = this.addAnnot({" & _
110         "    page: @p ," & _
111         "    type: 'FreeText' ," & _
112         "    textFont: 'Viva-Regular' ," & _
113         "    textSize: 10 ," & _
114         "    alignment: 'align_left' ," & _
115         "    rect: [@r] ," & _
116         "    width: 0 ," & _
117         "    contents: '@t' ," & _
118         "    textColor: @c  ," & _
119         "    strokeColor: ['T'] ," & _
120         "});"
121 
122 '        "    lock: true ," & _
123 '        "    fillColor: ['T'] ," & _
124 
125     '右矢印の表示
126     Const sAcrobatJavaScript3_1 = _
127         "var annot = this.addAnnot({" & _
128         "    type: 'Line'," & _
129         "    page: @p," & _
130         "    doCaption: false," & _
131         "    points: [[30,30],[30,60]]," & _
132         "    arrowEnd: 'ClosedArrow'," & _
133         "});"
134     '上矢印の表示
135     Const sAcrobatJavaScript3_2 = _
136         "var annot = this.addAnnot({" & _
137         "    type: 'Line'," & _
138         "    page: @p," & _
139         "    doCaption: false," & _
140         "    points: [[30,30],[60,30]]," & _
141         "    arrowEnd: 'ClosedArrow'," & _
142         "});"
143     '(X)の表示
144     Const sAcrobatJavaScript3_3 = _
145         "var annot = this.addAnnot({" & _
146         "    page: @p," & _
147         "    type: 'FreeText'," & _
148         "    textFont: 'Viva-Regular'," & _
149         "    textSize: 6," & _
150         "    alignment: 'align_left'," & _
151         "    rect: [63,20,88,35]," & _
152         "    width: 0 ," & _
153         "    contents: '(X)'," & _
154         "});"
155     '(Y)の表示
156     Const sAcrobatJavaScript3_4 = _
157         "var annot = this.addAnnot({" & _
158         "    page: @p," & _
159         "    type: 'FreeText'," & _
160         "    textFont: 'Viva-Regular'," & _
161         "    textSize: 6," & _
162         "    alignment: 'align_left'," & _
163         "    rect: [22,59,37,75]," & _
164         "    width: 0 ," & _
165         "    contents: '(Y)'," & _
166         "});"
167     '座標の表示サイズ
168     Const PT_X = 60     'X
169     Const PT_Y = 13     'Y
170 
171     If Dir$(sInFilePathIn, vbNormal) = "" Then
172         MsgBox sInFilePathIn & vbCrLf & _
173             "ファイルが存在しない。", _
174             vbOKOnly + vbCritical, "実行エラー"
175         DrawRuledLines = False
176         Exit Function
177     End If
178     
179     'ページ番号のチェック
180     If lInPageStart = -1 Then
181     ElseIf lInPageStart > 0 Then
182     Else
183         MsgBox "lInPageStart = " & lInPageStart & vbCrLf & _
184             "開始ページ番号の誤り。", _
185             vbOKOnly + vbCritical, "実行の中断"
186         DrawRuledLines = False
187         Exit Function
188     End If
189     'ページ番号のチェック
190     If lInPageEnd = -1 Then
191     ElseIf lInPageEnd > 0 Then
192         If lInPageEnd >= lInPageStart Then
193         Else
194             MsgBox "lInPageEnd = " & lInPageEnd & vbCrLf & _
195                 "終了ページ番号の誤り。", _
196                 vbOKOnly + vbCritical, "実行の中断"
197             DrawRuledLines = False
198             Exit Function
199         End If
200     Else
201         MsgBox "lInPageEnd = " & lInPageEnd & vbCrLf & _
202             "終了ページ番号の誤り。", _
203             vbOKOnly + vbCritical, "実行の中断"
204         DrawRuledLines = False
205         Exit Function
206     End If
207     
208     'Acrobatオブジェクトの定義＆作成
209     '※ここのオブジェクトをグローバル変数にしては駄目！
210     '　Acrobat 7,8,9,10,11 の時
211     Dim objAcroApp          As New Acrobat.AcroApp
212     Dim objAcroAVDoc        As New Acrobat.AcroAVDoc
213     Dim objAcroPDDoc        As New Acrobat.AcroPDDoc
214     Dim objAcroPDPage       As Acrobat.AcroPDPage
215     Dim objAcroAVPageView   As Acrobat.AcroAVPageView
216     Dim objAFormApp         As New AFORMAUTLib.AFormApp
217     Dim objAFormFields      As AFORMAUTLib.Fields
218     Dim objAFormField       As AFORMAUTLib.Field
219     Dim objAcroPoint        As Acrobat.AcroPoint
220 
221     objAcroApp.CloseAllDocs
222     objAcroApp.Hide '稀にデスクトップに表示されるので隠す
223 
224     'PDFファイルを開く
225     If objAcroAVDoc.Open(sInFilePathIn, "") = False Then
226         MsgBox "Open出来ません。" & vbCrLf & sInFilePathIn, _
227             vbOKOnly + vbCritical, "実行エラー"
228         DrawRuledLines = False
229         GoTo Skip_DrawRuledLines_END:
230     End If
231 
232     Application.Cursor = xlWait     'マウスポインターを砂時計
233     Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
234     iPageStart = IIf(lInPageStart = -1, 0, lInPageStart - 1)
235     iPageEnd = IIf(lInPageEnd = -1, objAcroPDDoc.GetNumPages, lInPageEnd) - 1
236     
237     Set objAFormFields = objAFormApp.Fields
238     Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
239     
240     Dim iPageX      As Long
241     Dim iPageY      As Long
242     Dim iX          As Long
243     Dim iY          As Long
244     Dim iXwk        As Long
245     Dim iYwk        As Long
246     
247     For iPageNo = iPageStart To iPageEnd
248         DoEvents
249         Set objAcroPDPage = objAcroPDDoc.AcquirePage(iPageNo)
250         
251         '▼ページサイズを取得する
252         Set objAcroPoint = objAcroPDPage.GetSize
253         With objAcroPoint
254             iPageX = .x
255             iPageY = .y
256         End With
257         iX = Int(iPageX / iLeng)
258         iY = Int(iPageY / iLeng)
259 
260         '▼罫線用のAcrobat JavaScriptを作成＆実行
261         sAJS_MG = ""
262         '縦の罫線
263         For i1 = 1 To iY
264             'Acrobat JavaScriptの編集
265             sAJS = sAcrobatJavaScript
266             sPoints = "[0," & i1 * iLeng & _
267                 "],[" & iPageX & "," & i1 * iLeng & "]"
268             sAJS = Replace(sAJS, "@r", sPoints)
269             sAJS = Replace(sAJS, "@p", iPageNo)
270             sAJS = Replace(sAJS, "@c", "color.green")
271             sAJS_MG = sAJS_MG & sAJS
272         Next i1
273         
274         '横の罫線
275         For i1 = 1 To iX
276             'Acrobat JavaScriptの編集
277             sAJS = sAcrobatJavaScript
278             sPoints = "[" & i1 * iLeng & _
279                 ",0],[" & i1 * iLeng & "," & iPageY & "]"
280             sAJS = Replace(sAJS, "@r", sPoints)
281             sAJS = Replace(sAJS, "@p", iPageNo)
282             sAJS = Replace(sAJS, "@c", "color.green")
283             sAJS_MG = sAJS_MG & sAJS
284         Next i1
285         'Acrobat JavaScript の実行
286         sReturn = objAFormFields.ExecuteThisJavascript(sAJS_MG)
287         
288         '▼座標表示用のAcrobat JavaScriptを作成＆実行
289         sAJS_MG = ""
290         For i1 = 0 To iX
291             iXwk = i1 * iLeng
292             For i2 = 0 To iY
293                 iYwk = i2 * iLeng
294                 sAJS = sAcrobatJavaScript2
295                 sPoints = iXwk + 1 & "," & iYwk + 1 & _
296                     "," & iXwk + PT_X & "," & iYwk + PT_Y
297                 sAJS = Replace(sAJS, "@r", sPoints)
298                 sAJS = Replace(sAJS, "@p", iPageNo)
299                 sAJS = Replace(sAJS, "@c", "color.blue")
300                 If i1 = 0 And i2 = 0 Then
301                     sAJS = Replace(sAJS, "@t", "(0,0):(X,Y)")
302                 Else
303                     sAJS = Replace(sAJS, "@t", _
304                         "(" & iXwk & "," & iYwk & ")")
305                 End If
306                 sAJS_MG = sAJS_MG & sAJS
307             Next i2
308         Next i1
309         '右上隅の座標
310         sAJS = sAcrobatJavaScript2
311         sPoints = iPageX + 1 - PT_X & "," & _
312                   iPageY + 1 - PT_Y - 2 & "," & _
313                   iPageX & "," & _
314                   iPageY - 2
315         sAJS = Replace(sAJS, "@r", sPoints)
316         sAJS = Replace(sAJS, "@p", iPageNo)
317         sAJS = Replace(sAJS, "@c", "color.blue")
318         sAJS = Replace(sAJS, "@t", "(" & iPageX & "," & _
319                                          iPageY & ")")
320         sAJS_MG = sAJS_MG & sAJS
321         'Acrobat JavaScript の実行
322         sReturn = objAFormFields.ExecuteThisJavascript(sAJS_MG)
323     
324         '▼矢印と(X),(Y)の表示
325         sAJS_MG = ""
326         For i1 = 1 To 4
327             Select Case i1
328             Case 1: sAJS = sAcrobatJavaScript3_1
329             Case 2: sAJS = sAcrobatJavaScript3_2
330             Case 3: sAJS = sAcrobatJavaScript3_3
331             Case 4: sAJS = sAcrobatJavaScript3_4
332             End Select
333             sAJS = Replace(sAJS, "@p", iPageNo)
334             sAJS_MG = sAJS_MG & sAJS
335         Next i1
336         'Acrobat JavaScript の実行
337         sReturn = objAFormFields.ExecuteThisJavascript(sAJS_MG)
338         
339     Next iPageNo
340     
341     'PDFファイルを別名で保存
342     Dim sFilePathOut        As String
343     sFilePathOut = Replace(sInFilePathIn, ".pdf", "-RuledLines.pdf")
344     If objAcroPDDoc.Save(1, sFilePathOut) = False Then
345         MsgBox "PDFファイルへ保存出来ませんでした", _
346             vbOKOnly + vbCritical, "実行エラー"
347     End If
348     
349     Application.Cursor = xlDefault  'マウスポインターを戻す
350     'PDFファイルを閉じる
351     If objAcroAVDoc.Close(False) = False Then
352         MsgBox "AVDocオブジェクトはClose出来ませんでした", _
353                 vbOKOnly + vbCritical, "実行エラー"
354         DrawRuledLines = False
355     End If
356 
357 Skip_DrawRuledLines_END:
358 
359 On Error Resume Next    'これ以降は強制実行
360 
361     Application.Cursor = xlDefault  'マウスポインターを戻す
362     '変更しないで閉じます。
363     bRet = objAcroAVDoc.Close(False)
364     'Acrobatアプリケーションの終了
365     objAcroApp.Hide
366     objAcroApp.Exit
367     'オブジェクトの開放
368     Set objAcroPoint = Nothing
369     Set objAFormFields = Nothing
370     Set objAFormField = Nothing
371     Set objAFormApp = Nothing
372     Set objAcroAVPageView = Nothing
373     Set objAcroPDPage = Nothing
374     Set objAcroPDDoc = Nothing
375     Set objAcroAVDoc = Nothing
376     Set objAcroApp = Nothing
377 
378     Debug.Print "Total Time = " & Timer - start & _
379         " PageCnt = " & iPageEnd - iPageStart + 1
380     
381     Exit Function
382 
383 Err_DrawRuledLines:
384     MsgBox "処理は以下の理由で中断しました。" & vbCrLf & _
385         vbCrLf & Err.Number & vbCrLf & Err.Description, _
386         vbOKOnly + vbCritical, "実行エラー"
387     DrawRuledLines = False
388     GoTo Skip_DrawRuledLines_END:
389 End Function
390 
391 '*********************************************
392 '   メモリ上のAcrobatプロセスを数える。
393 '*********************************************
394 Private Function iCheckAcrobat() As Long
395 'On Error GoTo skip_iCheckAcrobat:  'VBA実行時エラー
396     Dim items   As Object
397     Set items = CreateObject("WbemScripting.SWbemLocator") _
398             .ConnectServer.ExecQuery( _
399                 "Select * From Win32_Process " & _
400                 "Where Name = 'Acrobat.exe'")
401     '1以上はプロセス有り、0は無し
402     iCheckAcrobat = items.Count
403 '    Exit Function
404 'skip_iCheckAcrobat:
405 '    miErrorNo = Err.Number
406 '    msErrorMsg = Err.Description
407 End Function
408 
409 '*********************************************
410 '   メモリ上に残ったAcrobatプロセスを
411 '   正常に終了させる為だけの処理です。
412 '*********************************************
413 Sub EndAcrobat()
414 On Error Resume Next
415     Dim objAcroApp          As New Acrobat.AcroApp
416     Dim objAcroAVDoc        As New Acrobat.AcroAVDoc
417     Dim objAcroPDDoc        As New Acrobat.AcroPDDoc
418     Dim objAcroPDPage       As Acrobat.AcroPDPage
419     Dim objAcroAVPageView   As Acrobat.AcroAVPageView
420     Dim objAFormApp         As New AFORMAUTLib.AFormApp
421     Dim objAFormFields      As AFORMAUTLib.Fields
422     Dim objAFormField       As AFORMAUTLib.Field
423     Dim objAcroPoint        As Acrobat.AcroPoint
424     
425     objAcroApp.CloseAllDocs
426     objAcroApp.Hide
427     objAcroApp.Exit
428     
429     Set objAcroPoint = Nothing
430     Set objAFormFields = Nothing
431     Set objAFormField = Nothing
432     Set objAFormApp = Nothing
433     Set objAcroAVPageView = Nothing
434     Set objAcroPDPage = Nothing
435     Set objAcroPDDoc = Nothing
436     Set objAcroAVDoc = Nothing
437     Set objAcroApp = Nothing
438     
439     '上記の実行後にメモリ上から消える、はず。
440     MsgBox "Acrobat OLEの終了を試みました。" & _
441         vbCrLf & "10秒後にメモリから消えたのを" & _
442         vbCrLf & "タスクマネージャーで確認して下さい。", _
443         vbSystemModal + vbInformation, "お知らせ"
444 End Sub

実行結果

当ページの概要にある画像が実行結果です。

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 ]