PDF上に罫線と座標を表示

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


Osaka streets by night

概要

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

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

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

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

  1. 線(Line)
  2. フリーテキスト(FreeText)

 

サンプル

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

  1. sInFilePathIn As String:
    処理する入力PDFのフルパス名
  2. lInPageStart As Long:
    処理を開始するページ番号、-1は先頭ページの指定
  3. lInPageEnd As Long:
    処理を終了するページ番号、-1は最終ページの指定
  4. 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の解説

ここではポイントとなる部分のみを解説します。それ以外は

を御覧ください。

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

 

備考

  • 座標の計算以外は大したこと無いロジックです。

 

参照

「PDF上に罫線と座標を表示」への1件のフィードバック

  1. 何故か、原点が右上となります。
    Windows11, Acrobat2020, Excel2019

    objAFormFields.Addだと左下が原点になります。

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

CAPTCHA



SAMURAI Plugin

コメントをする時は出来れば以下もお願いします。

  • OS名 バージョン
  • Acrobat バージョン
  • ツール(Excel等) バージョン
コメントにサンプルコードを入れる時はコードを全て全角文字列にしてください。コチラで半角に戻します。それでもエラーが回避できない時はコメント下さい。個別に対処します。



お仕事で当サイトを見ている方へ
考え込んだら、ご質問下さい。
一緒に解決策を考えましょう。

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください