関数:文字列検索でページ番号と座標を返す

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

Tradition in Kyoto

概要

PDFのページ上のテキストを検索し、一致したページ番号とその座標(TOP、Bottom、Left、Right)を返します。

座標が有れば、以下のようにテキスト上にボタンを貼り付けたり、リンク、注釈、ハイライトを設定したりする事が可能になります。(注意:当関数にはその機能は無い。

リンク
★ PDFの座標がわかれば、こんな事も出来る ★

 

機能

  1. 指定したページのテキストを検索します。
  2. 検索テキストは半角文字、全角文字(日本語)、混在の文字、複数の単語が含まれた(途中に半角の空白)でも構いません。
  3. 一致したテキストの座標(TOP、Bottom、Left、Right)を返します。座標はページ左下を基点とします。
  4. 検索テキストが複数行にまたがる場合は複数の座標を返します。

 

座標が検索文字の位置に合わない時が有ります。
・PDFが古すぎる
・Acrobat等でテキストを強制的に修正した
・PDF内部の情報に何らかの問題が有る
必ず結果は目視で確認してください。

 

注意

  1. ページにまたがるテキストは検索できません。
  2. 半角英字は大文字小文字を判断します。
    判断しないは処理が複雑になるのでしなかった。
    対処:大文字有り、大文字無しを検索文字にして対応する

 

形式

Public Function GetTextsGetRects( _
  ByVal sInFilePathIn As String , _
  ByVal lInPageStart As Long , _
  ByVal lInPageEnd As Long , _
  ByRef sInSerchText() As String , _
  ByRef lOutData() As Long , _
  ByRef lOutCnt As Long ) As Boolean

 

引数

  1. 第一引数(string sInFilePathIn):検索するPDFのフルパス
  2. 第二引数(Long lInPageStart):検索の開始ページ
    -1 を入れると全ページ検索する。
  3. 第三引数(Long lInPageEnd): 検索の終了ページ
    -1 を入れると最終ページまで検索する
  4. 第四引数(string sInSerchText( n )):検索する文字列
    配列で複数の指定が可能。
    配列の最後又はテキスト無しを最後とする。
  5. 第五引数(Long sOutData(x , 5)):検索した結果
    • sOutData(x , 0) : sInSerchTextの配列番号の n
      -1 は当配列の終了を示す
    • sOutData(x , 1) :ページ番号
    • sOutData(x , 2) :座標 TOP
    • sOutData(x , 3) :座標 Bottom
    • sOutData(x , 4) :座標 Left
    • sOutData(x , 5) :座標 Right
  6. 第六引数(Long sOutCnt): sOutData の登録件数

 

戻り値

  1. True : 正常処理
  2. False : エラー処理。第一引数のファイルがPDFで無い等

 

動作検証した環境

  • Windows 10 64bit Pro
  • Adobe Acrobat XI Pro (バージョン 11.0.23)
  • MS Office - Excel 2007 - VBA

 

 

VBAサンプル

複数の検索テキストを指定し、結果はDebug.Printで確認する。更にPDFへ座標を使って注釈を貼り付けて確認する。

ダウンロード:sample-GetTextsGetRects.xls

001 Option Explicit 002 003 Private Const DEBUG_MODE As Boolean = False 004 005 Private Const MaxiSearchCnt As Long = 9999 '最大の検索件数 006 Private Const MaxiGetTextEnd As Long = 32767 'ハイライトテキストの最大数 007 Private Const MaxiZahyo As Long = 999 '検索文字列の文字数 008 009 '関数で使うEnum変数 010 Private Enum Zahyo '四方座標 011 Top = 0 012 bottom = 1 013 Left = 2 014 Right = 3 015 End Enum 016 017 Public Enum eOut '関数で使う配列の位置 018 Index = 0 'インデックス 019 Page = 1 'ページ番号 020 Top = 2 'TOP 021 bottom = 3 'Bottom 022 Left = 4 'Left 023 Right = 5 'Right 024 End Enum 025 026 027 '************************************************** 028 ' 029 ' Get Texts and Rects from PDF Page 030 ' 031 ' Create : 2020/03/25 032 ' Update : 2020/03/25 033 ' Vertion : 1.0.0 034 ' 035 ' 引数1 : sInFilePathIn As String (IN) 036 ' 検索するPDFのフルパスdebu 037 ' 引数2 :lInPageStart As Long (IN) 038 ' 検索の開始ページ 039 ' -1は最初から検索 040 ' 引数3 :lInPageEnd As Long (IN) 041 ' 検索の終了ページ 042 ' -1で最終ページまで検索 043 ' 引数4 :sInSerchText(n) As String (IN) 044 ' 検索する文字列 045 ' 配列の最後又はテキスト無しを最後と判断 046 ' 引数5 :lOutData(x , 5) As Long (OUT) 047 ' 検索した結果 048 ' sOutData(x , 0) :sInSerchTextの配列番号のn 049 ' -1 は当配列の終了 050 ' sOutData(x , 1) :ページ番号 051 ' sOutData(x , 2) :座標 TOP 052 ' sOutData(x , 3) :座標 Bottom 053 ' sOutData(x , 4) :座標 Left 054 ' sOutData(x , 5) :座標 Right 055 ' 引数6 :lOutCnt As Long (OUT) 056 ' sOutData の登録件数 057 ' 058 ' 戻り値 : True 正常処理 059 ' False エラー処理 PDFで無い 060 ' 061 ' 注意 : ・ページにまたがるテキストは検索しません。 062 ' ・処理時間が掛かります。 063 ' 064 ' URL : https://pdf-file.nnn2.com/?p=*** 065 ' 066 ' その他 : 著作権等は主張しません。 067 ' 上記URLにコメントを頂けると嬉しいです。 068 ' 069 '************************************************** 070 071 Public Function GetTextsGetRects( _ 072 ByVal sInFilePathIn As String, _ 073 ByVal lInPageStart As Long, _ 074 ByVal lInPageEnd As Long, _ 075 ByRef sInSerchText() As String, _ 076 ByRef lOutData() As Long, _ 077 ByRef lOutCnt As Long) As Boolean 078 079 On Error GoTo Err_GetTextsGetRects: 080 081 '初期値 082 GetTextsGetRects = True 083 lOutCnt = 0 084 085 Dim i1 As Long 086 Dim i2 As Long 087 Dim i3 As Long 088 Dim i4 As Long 089 Dim iT1 As Long 090 Dim j As Long 091 Dim iOut As Long 092 Dim iPageNo As Long 093 Dim iPageCnt As Long 094 Dim iRet As Long 095 Dim bRet As Boolean 096 Dim iPageStart As Long 097 Dim iPageEnd As Long 098 099 Dim sPageTextAll As String 100 Dim sSearchText_R As String 101 Dim sSearchText_WK As String 102 Dim iSearchTextCnt() As Long 103 Dim iSearchCnt As Long 104 Dim iCnt As Long 105 Dim iGetTextEnd As Long 106 Dim iZahyo(MaxiGetTextEnd, 3) As Long 107 Dim sGetText(MaxiGetTextEnd) As String 108 Dim sText As String 109 Dim sText_Mae As String 110 Dim iLenzoku As Long 111 Dim iSearchTextLen As Long 112 Dim sWk1 As String 113 Dim swk2() As String 114 Dim sWk3 As String 115 Dim iAddCnt As Long 116 Dim iWkZahyo(MaxiZahyo, 3) As Long 117 Dim iSpaceCnt As Long 118 119 Dim iLeft As Long '右の座標 120 Dim iRight As Long '左の座標 121 Dim iTop As Long '上の座標 122 Dim iBottom As Long '下の座標 123 124 '初期値 125 ReDim iSearchTextCnt(UBound(sInSerchText)) As Long 126 'Erase iSearchTextCnt 'ReDim配列のEraseは駄目 127 Erase iWkZahyo 128 Erase iZahyo 129 Erase sGetText 130 131 If Dir$(sInFilePathIn, vbNormal) = "" Then 132 MsgBox sInFilePathIn & vbCrLf & _ 133 "ファイルが存在しない。", _ 134 vbOKOnly + vbCritical, "実行エラー" 135 GetTextsGetRects = False 136 Exit Function 137 End If 138 139 'Acrobatオブジェクトの定義&作成 140 '※ここのオブジェクトをグローバル変数にしては駄目! 141 'Acrobat 7,8,9,10,11 の時 142 Dim objAcroApp As New Acrobat.AcroApp 143 Dim objAcroAVDoc As New Acrobat.AcroAVDoc 144 Dim objAcroPDDoc As New Acrobat.AcroPDDoc 145 Dim objAcroPDPage As Acrobat.AcroPDPage 146 Dim objAcroPoint As Acrobat.AcroPoint 147 Dim objAcroHiliteList As New Acrobat.AcroHiliteList 148 Dim objAcroAVPageView As Acrobat.AcroAVPageView 149 Dim objAcroPDTextSelect As Acrobat.AcroPDTextSelect 150 Dim objAcroRect As Acrobat.AcroRect 151 152 objAcroApp.CloseAllDocs 153 objAcroApp.Hide '稀にデスクトップに表示されるので隠す 154 155 'PDFファイルを開く 156 If objAcroAVDoc.Open(sInFilePathIn, "") = False Then 157 MsgBox "Open出来ません。" & vbCrLf & sInFilePathIn, _ 158 vbOKOnly + vbCritical, "実行エラー" 159 GetTextsGetRects = False 160 GoTo Skip_GetTextsGetRects_END: 161 End If 162 163 Application.Cursor = xlWait 'マウスポインターを砂時計 164 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc 165 iPageStart = IIf(lInPageStart = -1, 0, lInPageStart - 1) 166 iPageEnd = IIf(lInPageEnd = -1, objAcroPDDoc.GetNumPages, lInPageEnd) - 1 167 iOut = 0 168 169 For iPageNo = iPageStart To iPageEnd 170 171 If DEBUG_MODE Then Debug.Print _ 172 "処理の開始ページ-" & iPageNo + 1 & " : " & Time 173 DoEvents 174 175 '▼頁の全文字列を抽出 176 sPageTextAll = "" 177 Set objAcroHiliteList = Nothing '先にクリアが必要 178 'ハイライトリストを作成 179 iRet = objAcroHiliteList.Add(0, MaxiGetTextEnd) 180 'ページ単位のPDPageオブジェクトを作成 181 Set objAcroPDPage = objAcroPDDoc.AcquirePage(iPageNo) 182 'ハイライトリスト(objAcroHiliteList)からページ単位の 183 'テキスト選択のPDTextSelectオブジェクトを作成 184 Set objAcroPDTextSelect = _ 185 objAcroPDPage.CreateWordHilite(objAcroHiliteList) 186 'ページ上にテキストが存在しない時は Nothing 187 If objAcroPDTextSelect Is Nothing Then GoTo Skip_Next_Page: 188 189 '抽出した文字列の数(Index)を取得 190 iCnt = objAcroPDTextSelect.GetNumText() - 1 191 For j = 0 To iCnt 192 'GetText単位で抽出。一文字では無い。 193 '※半角英字は単語単位、日本語は1文字単位 194 sWk3 = objAcroPDTextSelect.GetText(j) 195 '改行コードを削除 196 sWk3 = Replace(sWk3, vbCrLf, "") 197 sGetText(j) = sWk3 198 sPageTextAll = sPageTextAll & sWk3 199 iGetTextEnd = j 200 Next j 201 202 '▼検索文字列が頁内に存在するかチェック 203 iSearchCnt = 0 204 For i3 = 0 To UBound(sInSerchText) 205 swk2 = Split(sPageTextAll, sInSerchText(i3)) 206 iSearchCnt = iSearchCnt + UBound(swk2) 207 iSearchTextCnt(i3) = UBound(swk2) 208 If DEBUG_MODE Then Debug.Print "sInSerchText(" & _ 209 i3 & ")=" & sInSerchText(i3) & " Hit(" & _ 210 iSearchTextCnt(i3) & ")" 211 Next i3 212 If iSearchCnt = 0 Then GoTo Skip_Next_Page: 213 214 '▼該当する文字列が有る 215 'ページ単位のPDPageオブジェクトを作成する 216 Set objAcroPDPage = objAcroPDDoc.AcquirePage(iPageNo) 217 218 DoEvents 219 iLenzoku = 0 220 221 For iT1 = 0 To UBound(sInSerchText) 222 223 If iSearchTextCnt(iT1) = 0 Then GoTo Skip_Next_iT1: 224 225 sSearchText_WK = sInSerchText(iT1) 226 iSpaceCnt = UBound(Split(sInSerchText(iT1), " ")) 'Space数 227 iSearchTextLen = Len(sSearchText_WK) 228 229 For i1 = 0 To iGetTextEnd 230 sText = "" 231 iAddCnt = 0 232 sSearchText_R = sSearchText_WK 233 234 For i2 = i1 To iGetTextEnd 235 236 sText = sText & sGetText(i2) 237 iAddCnt = iAddCnt + 1 238 If iAddCnt >= MaxiZahyo Then 239 MsgBox "プログラミング的なエラーが発生しました。" & _ 240 vbCrLf & "原因:iAddCnt が制限を越えました。" & _ 241 vbCrLf & "処理は強制終了します。", _ 242 vbCritical, "実行エラー" 243 GetTextsGetRects = False 244 Stop '強制中断 245 GoTo Skip_GetTextsGetRects_END: 246 End If 247 If iSpaceCnt <> 0 Then 248 If iAddCnt <= iSpaceCnt Then GoTo Skip_Next_i2: 249 End If 250 251 If Len(sText) >= iSearchTextLen Then 252 253 If InStr(sText, sSearchText_R) = 0 Then Exit For 254 255 If Len(sGetText(i1)) >= InStr(sText, sSearchText_R) Then 256 'sGetText(i1)の文字列から検索キーが始まっている 257 258 '▼四方座標を取得 Start 259 For i4 = 0 To iAddCnt - 1 260 'ハイライトリストを作成 261 Set objAcroHiliteList = Nothing '先にクリアが必要 262 '第2引数を1にしないと文字単位に四方座標が取れない。 263 iRet = objAcroHiliteList.Add(i1 + i4, 1) 264 'ハイライトリスト(objAcroHiliteList)からページ単位の 265 'テキスト選択のPDTextSelectオブジェクトを作成する 266 Set objAcroPDTextSelect = _ 267 objAcroPDPage.CreateWordHilite(objAcroHiliteList) 268 'EOFの判断 269 If objAcroPDTextSelect Is Nothing Then 270 Stop 'プログラミング等での実行エラー 271 GetTextsGetRects = False 272 GoTo Skip_Next_Page: 273 End If 274 '選択状態になっている四方範囲(AcroRect)を取得する。 275 Set objAcroRect = objAcroPDTextSelect.GetBoundingRect 276 With objAcroRect 277 iWkZahyo(i4, Zahyo.Top) = .Top 278 iWkZahyo(i4, Zahyo.bottom) = .bottom 279 iWkZahyo(i4, Zahyo.Left) = .Left 280 iWkZahyo(i4, Zahyo.Right) = .Right 281 End With 282 If DEBUG_MODE Then 283 With objAcroRect 284 Debug.Print "(" & sGetText(i1 + i4) & _ 285 ") top=" & .Top & _ 286 " bottom=" & .bottom & _ 287 " Left=" & .Left & _ 288 " Right=" & .Right 289 End With 290 End If 291 Next i4 292 '▼四方座標を取得 End 293 294 iLeft = -1 295 For i4 = 0 To iAddCnt - 1 296 If i4 = iAddCnt - 1 Then 297 '最後(最終行)の処理 298 iTop = iWkZahyo(i4, Zahyo.Top) 299 iBottom = iWkZahyo(i4, Zahyo.bottom) 300 '>:右の座標 301 If InStr(sText, sSearchText_R) = 1 Then 302 '検索キーは先頭から有る 303 If iLeft = -1 Then _ 304 iLeft = iWkZahyo(i4, Zahyo.Left) 305 Else 306 '後ろのスペースをカット 307 sText = Replace(sText, " ", "") '● 308 '検索キーは2桁以降から始まる 309 iLeft = iWkZahyo(i4, Zahyo.Left) + _ 310 ((iWkZahyo(i4, Zahyo.Right) - _ 311 iWkZahyo(i4, Zahyo.Left)) / _ 312 Len(sText) * _ 313 (InStr(sText, sSearchText_R) - 1)) 314 End If 315 '<:左の座標 316 If Len(sText) = Len(sSearchText_R) Or _ 317 sText = sSearchText_R & Space(1) Then '● 318 '検索キーの終端は最後に有る 319 iRight = iWkZahyo(i4, Zahyo.Right) 320 Else 321 '後ろのスペースをカット 322 sText = Replace(sText, " ", "") '● 323 '検索キーの終端は最後から前に有る 324 iRight = iWkZahyo(i4, Zahyo.Left) + _ 325 ((iWkZahyo(i4, Zahyo.Right) - _ 326 iWkZahyo(i4, Zahyo.Left)) / _ 327 Len(sText) * _ 328 (InStr(sText, sSearchText_R) + _ 329 (Len(sSearchText_R) - 1))) 330 End If 331 '■座標情報を出力 332 lOutData(iOut, eOut.Index) = iT1 333 lOutData(iOut, eOut.Page) = iPageNo 334 lOutData(iOut, eOut.Top) = iTop 335 lOutData(iOut, eOut.bottom) = iBottom 336 lOutData(iOut, eOut.Left) = iLeft 337 lOutData(iOut, eOut.Right) = iRight 338 339 iOut = iOut + 1 340 iSearchTextCnt(iT1) = iSearchTextCnt(iT1) - 1 341 i2 = iGetTextEnd '次のキー検索に進ませる 342 iLeft = -1 343 Exit For 344 End If 345 If iWkZahyo(i4, Zahyo.Top) = _ 346 iWkZahyo(i4 + 1, Zahyo.Top) Then 347 '次は同じ行 348 If iLeft = -1 Then 349 If InStr(sText, sSearchText_R) = 1 Then 350 iLeft = iWkZahyo(i4, Zahyo.Left) 351 Else 352 iLeft = iWkZahyo(i4, Zahyo.Left) + _ 353 ((iWkZahyo(i4, Zahyo.Right) - _ 354 iWkZahyo(i4, Zahyo.Left)) / _ 355 Len(sGetText(i1 + i4)) * _ 356 (InStr(sText, sSearchText_R) - 1)) 357 End If 358 End If 359 Else 360 '次は別の行 361 iTop = iWkZahyo(i4, Zahyo.Top) 362 iBottom = iWkZahyo(i4, Zahyo.bottom) 363 '>:右の座標 364 If InStr(sText, sSearchText_R) = 1 Then 365 '検索キーは先頭から有る 366 If iLeft = -1 Then _ 367 iLeft = iWkZahyo(i4, Zahyo.Left) 368 Else 369 '検索キーは2桁以降から始まる 370 iLeft = iWkZahyo(i4, Zahyo.Left) + _ 371 ((iWkZahyo(i4, Zahyo.Right) - _ 372 iWkZahyo(i4, Zahyo.Left)) / _ 373 Len(sGetText(i1 + i4)) * _ 374 (InStr(sText, sSearchText_R) - 1)) 375 End If 376 '<:左の座標 377 iRight = iWkZahyo(i4, Zahyo.Right) 378 379 '■座標情報を出力 380 lOutData(iOut, eOut.Index) = iT1 381 lOutData(iOut, eOut.Page) = iPageNo 382 lOutData(iOut, eOut.Top) = iTop 383 lOutData(iOut, eOut.bottom) = iBottom 384 lOutData(iOut, eOut.Left) = iLeft 385 lOutData(iOut, eOut.Right) = iRight 386 387 iOut = iOut + 1 388 iSearchTextCnt(iT1) = iSearchTextCnt(iT1) - 1 389 iLeft = -1 390 End If 391 '処理済みの文字列は取り除く 392 sWk1 = sText 393 sText = Mid$(sWk1, Len(sGetText(i1 + i4)) + 1) 394 sSearchText_R = Mid$(sSearchText_R, _ 395 Len(sGetText(i1 + i4)) - _ 396 InStr(sWk1, sSearchText_R) + 2) 397 Next i4 398 Else 399 If Len(sText) >= iSearchTextLen Then Exit For 400 End If 401 402 End If 403 Skip_Next_i2: 404 Next i2 405 Next i1 406 Skip_Next_iT1: 407 Next iT1 408 Skip_Next_Page: 409 Next iPageNo 410 411 lOutData(iOut, eOut.Index) = -1 412 413 Application.Cursor = xlDefault 'マウスポインターを戻す 414 415 'PDFファイルを閉じる 416 If objAcroAVDoc.Close(False) = False Then 417 MsgBox "AVDocオブジェクトはClose出来ませんでした", _ 418 vbOKOnly + vbCritical, "実行エラー" 419 GetTextsGetRects = False 420 End If 421 422 Skip_GetTextsGetRects_END: 423 424 On Error Resume Next 'これ以降は強制実行 425 426 Application.Cursor = xlDefault 'マウスポインターを戻す 427 428 '変更しないで閉じます。 429 bRet = objAcroAVDoc.Close(False) 430 'Acrobatアプリケーションの終了 431 objAcroApp.Hide 432 objAcroApp.Exit 433 434 'オブジェクトの開放 435 Set objAcroHiliteList = Nothing 436 Set objAcroAVPageView = Nothing 437 Set objAcroPDTextSelect = Nothing 438 Set objAcroRect = Nothing 439 Set objAcroPDPage = Nothing 440 Set objAcroPoint = Nothing 441 Set objAcroPDDoc = Nothing 442 Set objAcroAVDoc = Nothing 443 Set objAcroApp = Nothing 444 445 lOutCnt = iOut '出力件数 446 Exit Function 447 448 Err_GetTextsGetRects: 449 MsgBox "処理は以下の理由で中断しました。" & vbCrLf & vbCrLf & _ 450 Err.Number & vbCrLf & Err.Description, _ 451 vbOKOnly + vbCritical, "実行エラー" 452 GetTextsGetRects = False 453 GoTo Skip_GetTextsGetRects_END: 454 End Function 455 456 457 '************************************************** 458 ' 459 ' 関数をテストする為の呼び出しルーチン 460 ' 461 ' 関数を呼び出し後、結果を確認する為に、 462 ' 座標からPDFに注釈を貼り付ける。 463 ' 464 '************************************************** 465 466 Sub Test_Main() 467 468 Dim start As Double: start = Timer 469 470 Dim bRet As Boolean 471 Dim sFilePathIn As String 472 Dim lOutData(100, 5) As Long 473 Dim iOutCnt As Long 474 Dim sInSerchText() As String 475 ReDim sInSerchText(12) As String 476 Dim i1 As Long 477 478 i1 = 0 479 sInSerchText(i1) = "ATA": i1 = i1 + 1 480 sInSerchText(i1) = "ス63": i1 = i1 + 1 481 sInSerchText(i1) = "Windows": i1 = i1 + 1 482 sInSerchText(i1) = "Home 64": i1 = i1 + 1 483 sInSerchText(i1) = "10": i1 = i1 + 1 484 sInSerchText(i1) = "8GB": i1 = i1 + 1 485 sInSerchText(i1) = "USB": i1 = i1 + 1 486 sInSerchText(i1) = "HDD": i1 = i1 + 1 487 sInSerchText(i1) = "i5-9400": i1 = i1 + 1 488 sInSerchText(i1) = "RAM": i1 = i1 + 1 489 sInSerchText(i1) = "音電": i1 = i1 + 1 490 sInSerchText(i1) = "6ス": i1 = i1 + 1 491 sInSerchText(i1) = "ル)": i1 = i1 + 1 492 sFilePathIn = ThisWorkbook.Path & "\test-002.pdf" 493 494 bRet = GetTextsGetRects(sFilePathIn, -1, -1, _ 495 sInSerchText, lOutData, iOutCnt) 496 497 '******************************************** 498 '▼ これ以降は結果を確認する為のロジック ▼ 499 '******************************************** 500 501 On Error Resume Next 502 Dim objAcroApp As New Acrobat.AcroApp 503 Dim objAcroAVDoc As New Acrobat.AcroAVDoc 504 Dim objAcroPDDoc As New Acrobat.AcroPDDoc 505 Dim objAcroPDPage As Acrobat.AcroPDPage 506 Dim objAcroPoint As Acrobat.AcroPoint 507 Dim objAcroHiliteList As New Acrobat.AcroHiliteList 508 Dim objAcroAVPageView As Acrobat.AcroAVPageView 509 Dim objAcroPDTextSelect As Acrobat.AcroPDTextSelect 510 Dim objAcroRect As Acrobat.AcroRect 511 Dim objAFormApp As AFORMAUTLib.AFormApp 512 Dim objAFormFields As AFORMAUTLib.Fields 513 objAcroApp.CloseAllDocs 514 objAcroApp.Hide '稀にデスクトップに表示されるので隠す 515 'PDFファイルを開く 516 bRet = objAcroAVDoc.Open(sFilePathIn, "") 517 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc 518 Set objAFormApp = CreateObject("AFormAut.App") 519 Set objAFormFields = objAFormApp.Fields 520 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc 521 Dim sAJS As String 522 Dim sReturn As String 523 Const sAcrobatJavaScript2 = _ 524 "oRet = this.addAnnot({type: ""Square"", " & _ 525 "rect:[@1,@2,@3,@4], " & _ 526 "page:@p , " & _ 527 "strokeColor:color.blue , width:0.3 , contents:""@t""}); " 528 For i1 = 0 To iOutCnt 529 If lOutData(i1, 0) = -1 Then Exit For 530 Debug.Print "Text(" & i1 & ")=" & _ 531 sInSerchText(lOutData(i1, eOut.Index)) & _ 532 " Index=" & lOutData(i1, eOut.Index) & _ 533 " Page=" & lOutData(i1, eOut.Page) & _ 534 " Top=" & lOutData(i1, eOut.Top) & _ 535 " Bottom=" & lOutData(i1, eOut.bottom) & _ 536 " Left=" & lOutData(i1, eOut.Left) & _ 537 " Right=" & lOutData(i1, eOut.Right) 538 sAJS = sAcrobatJavaScript2 539 sAJS = Replace(sAJS, "@t", _ 540 "Top=" & lOutData(i1, eOut.Top) & _ 541 " Bottom=" & lOutData(i1, eOut.bottom) & _ 542 " Left=" & lOutData(i1, eOut.Left) & _ 543 " Right=" & lOutData(i1, eOut.Right)) 544 sAJS = Replace(sAJS, "@1", lOutData(i1, eOut.Left)) 545 sAJS = Replace(sAJS, "@2", lOutData(i1, eOut.bottom)) 546 sAJS = Replace(sAJS, "@3", lOutData(i1, eOut.Right)) 547 sAJS = Replace(sAJS, "@4", lOutData(i1, eOut.Top)) 548 sAJS = Replace(sAJS, "@p", lOutData(i1, eOut.Page)) 549 'Acrobat JavaScript の実行 550 sReturn = objAFormFields.ExecuteThisJavascript(sAJS) 551 Next i1 552 'PDFファイルを別名で保存 553 Dim sFilePathOut As String 554 sFilePathOut = Replace(sFilePathIn, ".pdf", "-New.pdf") 555 If objAcroPDDoc.Save(1, sFilePathOut) = False Then 556 MsgBox "PDFファイルへ保存出来ませんでした", _ 557 vbOKOnly + vbCritical, "実行エラー" 558 End If 559 '変更しないで閉じます。 560 bRet = objAcroAVDoc.Close(False) 561 'Acrobatアプリケーションの終了 562 objAcroApp.Hide 563 objAcroApp.Exit 564 'オブジェクトの開放 565 Set objAcroHiliteList = Nothing 566 Set objAcroAVPageView = Nothing 567 Set objAcroPDTextSelect = Nothing 568 Set objAcroRect = Nothing 569 Set objAcroPDPage = Nothing 570 Set objAcroPoint = Nothing 571 Set objAcroPDDoc = Nothing 572 Set objAcroAVDoc = Nothing 573 Set objAFormApp = Nothing 574 Set objAFormFields = Nothing 575 Set objAcroApp = Nothing 576 Debug.Print "出力件数 = " & iOutCnt 577 Debug.Print "処理時間 = " & Timer - start 578 End Sub


 Highlight:プログラミング言語のソースコードを構文で色分け (GUI編)
 

 

結果

テキスト検索から得られた座標を使って、該当するテキスト上に青線の注釈を貼り付けました。注釈には得られた座標も表示しています。以下がその結果です。

 

複数行にまたがる座標

テキストの検索結果が複数行にまたがる場合はそれぞれの座標を返します。

上記は「構成する様々な要素」でテキスト検索し、「構成する」と「様々な要素」 の2つの座標を返します。

 

参照

 

備考

  • 関数のロジックはもう少し簡素に出来ますが、そうすると処理時間が数倍も掛かってしまいます。それを避けるために処理時間優先のロジックになっています。

 

コメントを残す

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

CAPTCHA


出来るだけ早く返答する様には心がけています。
が、遅くなる時もありますのでご了承ください。


SAMURAI Plugin

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

  • OS名 バージョン
  • Acrobat バージョン
  • ツール(Excel等) バージョン
コメントにサンプルコードを入れるとエラーになる場合が有ります。その時はコードの前後に <code> ・・・</code> タグを入れてください。

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