サイトマップ

▼ サイトの紹介

このサイトはExcel VBAから、Acrobat  アプリケーションをプログラミング操作するOLE機能について解説しています。

Adobe社はこのOLE機能の事を「IAC」と表現しています。

(注意:Adobe Readerだけでは使用出来ません)

Adobe社提供のSDK資料を元にサンプルを加えて説明をしています。

サイト管理人もご覧下さい。

▼ 当サイトの使い方

当サイトをうまく使う上での手順を以下に示します。

  1. 最初に「Acrobat SDK:OLE objects and methods図を入手する」にあるオブジェクト連携図を手に入れます。出来れば印刷する方が見やすいです。1頁です。
  2. 下記の「Excel」、「Acrobat」、「ダウンロード」、「SDK」、「備考」にサッと目を通します。「その他&メモ」は特に見なくてもイイです。
  3. 自分が目的とする処理を探しながら、印刷したオブジェクト連携図を元にサイト記「Object & List」下を上からクリックしてザックリと内容を見ます。各オブジェクトのメソッドの詳細は後にして全体で何が出来て、何が出来ない(サポートされていない)かを把握します。
    Acobat OLE 以外の選択」も見て下さい。
  4. 目的が解決出来ない時は、キッパリとあきらめてAdobe社の日本語「Acrobat アドビフォーラム」で相談します。 ココ ↓
    http://forums.adobe.com/community/international_forums/japanese/acrobat
    当サイト pdf-file.nnn2.com より質が高い。
  5. それでもダメなら、当サイトにコメントを入れてみます。サイト管理人がある程度、判る範囲でお答えをします。
    (お願い:管理人を「様」での呼び方はご遠慮下さい。管理人さ~んで十分です。)

▼ Excel

  1. Excel からAcrobatを操作する訳
  2. Excel から PDFファイル を作成&操作出来る
  3. Excel のオブジェクトブラウザ
  4. Excel からAcrobatを起動する
  5. Excel からPDFファイルを起動表示する
  6. Excel サンプル:PDFの文書プロパティを表示する
  7. 上記7のサンプルファイルの実行エラー
  8. Excel VBA 実行エラー時のメッセージ
  1. Excel でOLEの参照設定をする
  2. Excel でOLEの参照設定をする (AFormAut の追加)
  3. Excel でOLEの参照設定をする (Stream の追加)
  4. Excel でOLEの参照設定をする (MSXMLの追加)

▼ Acrobat

  1. Acrobat SDK:OLE objects and methods図を入手する
    ここで示す図は必ず入手する必要があります。
    これが無いとオブジェクト連携が判らなく、OLE(IAC)操作が出来ません。
  2. Acrobatアプリケーションを閉じる(実は簡単に出来ない)
  3. Acrobat OLE 使用上の注意事項
  4. Acrobatプログラミングにおける技術上の制約やライセンス上の制約
  5. PDFファイルを作成、及び操作する開発者に対しての注意事項
  6. Windows のコマンドラインから Acrobat や Adobe Reader を使用して印刷する方法
  7. PDFドキュメントの文書フラグとは
  8. PDF バージョンとは
  9. PDFバージョンの変化
  10. ExportTask.xml
  11. 一括で複数ファイルを処理(アクション、バッチ処理)
  12. PDF の3つのパスワード
  13. PDFのパスワードは32文字まで
  14. 印刷の問題点を解決
  15. PDF内での座標の起点
  16. Acrobatとレジストリ
  17. PDF上のテキストとその座標

▼ ダウンロード

  1. 各種サンプルのダウンロード
  2. Adobe Acrobat 9.1 SDK のダウンロード
    SDKをダウンロードしてサンプル、解説PDF,HTML等を入手する必要があります。
    Adobe Acrobat X SDK のダウンロード情報も入ってます。
  3. Adobe Acrobat 8.1 SDK のダウンロード
    この 8.1 バージョンのSDKは現時点(2013/10/03)で一般公開されてません。
    情報が入り次第、掲載します。
  4. Acrobat製品別ダウンロード先 URL
  5. AcroPDFLib.AxAcroPDF:Excel VBAサンプル(A)
  6. AcroPDFLib.AxAcroPDF:Excel VBAサンプル(B)
  7. Adobe Readerの各種バージョンのダウンロード

▼ SDK

  1. AcrobatプログラミングにおけるMenu and Toolbar Button Names 一覧
  2. PDDocのGetJsObjectのオブジェクト構造図が見当たらない
  3. Acrobat SDK:正誤表
    Acrobat SDK v8.1ドキュメントに記載ミスが有ります。
  4. Acrobatに関するSDKが Acrobat Developer Center からダウンロード出来ます。
  5. Acrobat JavaScript における「Safe Path:セーフパス」についての注意事項
  6. Acrobat SDK公開Webサイト URLの取得方法

▼ 備考

  1. JavaScriptの解説はAcrobat v7 v8 共に英語版です。しかし、旧バージョンですがコメントを頂いた方から日本語版のAcrobat JavaScript解説PDFが見つかりました。以下がそのPDFです。
    http://www.adobe.com/jp/support/products/pdfs/acrojs_j.pdf
  2. [2009/1/7] AcroExch.AVDoc:Open メソッド でバグ?を発見しました。Acrobat v8.1.3 v9.0が対象です。

 

▼ その他&メモ

  1. OCR機能:読んde!ココと比較した結果
  2. アドビ(Adobe)製品に関するRSSの情報
  3. 添付ファイルの扱いには注意が必要
  4. AcrobatはPDF作成ソフトの標準では無くなる?
  5. Acrobat PDF は国際標準化された
  6. 手書きPDF入門」 リンク
  7. planet pdf (PDF関連の英語サイト) リンク
  8. デフォルトプリンタを一時的に変更する方法
  9. Delphi(デルファイ,デルフィ)言語からの使用方法
  10. Acrobat使用時のレジストリ変化を取得する方法
  11. オブジェクトは値では無く、参照情報を持つ
  12. Adobe Reader で PDF ファイルを表示 / 印刷する方法
  13. サンプル:RGB値の一覧(カラー番号)
  14. 「・・このバージョンの Acrobat ではサポートされていない新しい形式・・」警告メッセージへの対応

▼日本語の資料

日本語版で公開されている技術情報が非常に少なく、また対応バージョンも古く、作成年度も古いのが多いです。しかし、PDF 又はAcrobat のエンジニア向けの基本的な技術はこの10年間はそれ程進歩していません。よって思った以上に使える事に気がつくはずです。

公開されている情報は今後消滅すると予想されます。必要な情報はバックアップする事をお勧めします。

▼ Acrobat SDK 関連

  1. Acrobat JavaScript Object Specification バージョン 5.0.5
    テクニカルノート# 5186 改訂日:2001年9月14日
    (297頁) Acrobat 5.0 JavaScript リファレンスマニュアル。
    PDF ドキュメントでJavaScript を使用するために必要なすべての情報。
    ※2018/10 リンク先は消滅しました。
  2. Developing Acrobat Applications Using JavaScript
    Adobe Acrobat SDK バージョン 8.0

    (220頁) JavaScript を使用してAdobe Acrobat での開発や拡張したりする方法について
    説明したマニュアル。必読!
  3. JavaScript for Acrobat 3D Annotations API Reference
    Adobe Acrobat SDK 2007年4月バージョン 8.1

    (105頁) 3D 機能(3D注釈のJavaScript API)をユーザに提供したい開発者を対象にしたマニュアル
  4. Parameters for Opening PDF Files(日本語版)
    Adobe Acrobat SDK Version 8.1 April 2007

    (8頁) PDF ファイルをURL やコマンドの中で開く際に使用できるパラメータについて説明したマニュアル
  5. Adobe Acrobat Workshop
    (78頁) Acrobat 7.0 JavaScript、API、IAC等の開発環境に関する概念の説明図
  6. Adobe Acrobat 7.0 Acrobat JavaScript Scripting Guide 2005年1月7日
    (276頁) Acrobat JavaScript を使用して開発したり拡張したりする方法について簡単に説明ししたもの
  7. Programming Acrobat JavaScript Using Visual Basic
    Technical Note #5417 バージョン:Acrobat 6.0 2003年5月

    (14頁) Acrobat 6.0 提供のJSObject と言うOLE オートメーション機能のプログラミング環境に関しての概念を説明したもの
  8. Acrobat JavaScript Scripting Guide
    Technical Note #5430 バージョン:Acrobat 6.0 2003年5月

    (90頁) Acrobat 6 Pro に搭載されている JavaScript 開発環境を使用して Acrobat アプリケーションを開発したり拡張したりする方法を簡単にまとめたもの
  9. Upgrading Plug-ins From Acrobat 5 to Acrobat 6
    Technical Note #5424 バージョン:Acrobat 6.0 2003年7月

    (28頁) Acrobat 6 API の概要を説明し、Acrobat 5 およびそれ以前のプラグインを Acrobat 6 にアップグレードする際に開発者が理解しておくべきことについて説明したマニュアル
  10. Adobe® Solutions Network Developer Program FAQ for Members
    Version 3.0 MAY 2002

    (461頁) ASNディベロッパーサポートプログラム会員から頂いたAcrobat Plug-in API,IAC,Readerに関する質問を整理した情報
  11. Acrobat Developer FAQ
    Adobe Developer Relations 改定:1999年9月2日

    (37頁) 質問および回答形式を整理した情報
  12. Parameters for Opening PDF Files(日本語版)
    Adobe Acrobat SDK Version 8.1 April 2007

    (24頁) Acrobat SDK でよくある質問と回答を整理したもの
  13. Adobe Acrobat 7.0 Acrobat SDK ユーザガイド 2004年12月14日
    (124頁) Acrobat SDKで提供されている機能、Acrobatで提供されている機能とその操作説明等
  14. JavaScript for Acrobat API Reference
    Adobe Acrobat SDK バージョン 8.0

    (765頁) Acrobat JavaScript の詳細な解説書/リファレンス

▼ Acrobat 一般資料

  1. Adobe Acrobat Security ディベロッパーサポート 2005年4月7日
    (43頁) Acrobat 7.0 の各種セキュリティに関する概念

管理人の独り言

  • 2010/4/26 「Appメソッド一覧」移行完了。かなり見直したので、結構解説が難しくなってしまったかも・・。全部の移行が完了したら、再度見直す事にして、次に行きます。
  • 2010/5/14 データの移行と再リンクが終わりました(汗)。サイトマップの構成も少し見直して・・。後は見直し(リニューアル)する必要有り。OLE(IAC)の全貌が判った時点で細かい部分の追加が必要となった。各頁にかなりの追加と再テストが必要だが既に環境は出来あがっている。本当の踏ん張ると事はココからかもしれない。
  • 2010/5/18 Appオブジェクトの移行が完了しました。
  • 2012/11/12 AFormAut オブジェクトが IAC に含まれていない盲点に orz
  • 2013/10/14 JavaScriptAPIと言う当サイト独自の表現を JSObject と本来の表現に変更する。
  • 2015/5/9 サイトのレイアウトを変更。

▼ Acobat OLE 以外の選択

Adobe Acrobat OLE(IAC)以外で、PDFファイルをプログラミング操作する情報を以下に提供します。

VBA の Shell 関数(又はWscriptのExec関数)で起動する事により、IACには無い機能で複数ファイルの自動化処理が可能だと思われます。

  1. Qpdf
    PDF をコマンドラインで操作するツール
    セキュリティ(パスワード)の設定が出来る!
  2. Poppler
    PDF をコマンドラインで操作するツール
    Xpdf をペースした機能拡張版
    注意:公式サイトからはWin版EXEは配布されてません。
  3. pdf2htmlEX
    PDF をHTMLへ変換する高性能なツール
  4. Coherent PDF Command Line Tools
    非常に多機能なコマンドラインツール
    ライセンスに注意が必要
  5. Xpdf
    PDF をコマンドラインで操作するツール
    Popplerの旧バージョン。安定版。
  6. PDFtk *  ※検証予定(時期未定)
    PDF をコマンドラインで操作するツール  
  7. PDFill PDF Writer: PDF作成ツール
    コマンドラインの使用は有償版のみ。
    無償版と有償版。表示は英語。
  8. ★その他の各種ソフトとツール★
    各種のPDFソフトウェアを一覧でまとめたサイトです。
    たぶん、ココの情報が最新で内容も充実してると思われます。

[コメント入力] <-をクリックするとページの最後にコメント入力が出来ます。
名前(ニックネーム)は必須。メールアドレス(非表示)も必須ですが、適当で結構です。

【更新日:2019/06/05 (11版)】

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

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

Tradition in Kyoto

概要

PDFページ上のテキストを検索し、以下の位置情報を返します。

  • ページ番号
  • 座標(Left、Right、Top、Bottom)

この位置情報が有れば、テキスト上へのボタン、リンク、注釈、ハイライト表示が可能になります。

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

当関数はAcrobat OLE経由でAcrobat JavaScriptを実行し、PDF上のテキストとその座標を得ます。

 

座標の扱いに問題が有ることが分かりました。当ページに書かれている内容は「正常に機能しない」場合が有ります。イタリック文字や回転文字には機能しません。現在は対応方法を検証しながら新バージョンの製作中。(2020/5/17)

 

機能

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

 

注意

  1. ページにまたがるテキストは検索できません。
  2. 半角英字は大文字小文字を区別します。
    理由:区別無しは処理が複雑になる為
    対処:大文字有り、大文字無しを検索文字にします
  3. 行の最後の文字列と、次の行の先頭の文字列が半角の時は連続文字として扱います。扱いたくない時の対処方法はこの後で説明します。

 

形式

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

 

引数

  1. 第一引数(sInFilePathIn):検索するPDFのフルパス
  2. 第二引数(lInPageStart):検索の開始ページ
    先頭ページは1です。
    -1 を入れると先頭ページから検索します。
  3. 第三引数(lInPageEnd): 検索の終了ページ
    -1 を入れると最終ページまで検索します。
  4. 第四引数(sInSerchText( n )):検索する文字列
    配列で複数の指定が可能。
    配列の最後又はテキスト無しを最後とします。
    注意:スペースが入った半角文字列の扱い
  5. 第五引数(gTextRects(x) As typeTextRect):検索した結果
    • iPageNo As Long :ページ番号
    • iSearchNo As Long:sInSerchTextの配列番号のn
      -1 は当配列の終了を示す
    • iLeft As Double:座標 Left
    • iRight As Double :座標 Right
    • iTop As Double :座標 Top
    • iBottom As Double :座標 Bottom
    • iRenzoku As Long :連続するテキストの連番
      検索テキストが複数行(列)にまたがると連番(1~)を付けます。0は単独です。
    • iWordNo As Long :JavaScriptで抽出した時の単語の番号
      現在は未使用。将来的な事を考慮。
  6. 第六引数(Long sOutCnt): gTextRects(x) の x 値

typeTextRectはユーザー定義形のType変数です。複数の戻り値を一箇所で扱っています。使い方はサンプルを御覧ください。

 

戻り値

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

 

動作検証した環境

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

 

 

関数のソース - VBA

以下のダウンロードファイルには当関数を使う上で必要な他の関数や、当関数をつかったサンプルロジック(ハイライト表示、長方形の注釈の作成)が入っています。

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

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

001 Option Explicit 002 003 'Debug Mode True:オン False:オフ 004 Private Const DEBUG_MODE As Boolean = False 005 006 'True :行の最後の半角文字列と、次行の最初の半角文字列を 007 '   連続した文字列として検索する 008 'False:行が変わると別の文字列として扱う。 009 Private Const CONTINUOUS_STRING As Boolean = True 010 '前のテキストの右端が次のテキストの左端より大きい場合は補正 011 Private Const MODIFY_THE_COORDINATES As Boolean = True 012 'テキストが同じ行かを判断する座標の差 013 Private Const CON_LINE_VARIATION = 0.9 014 015 '検索文字列の文字数 016 Private Const MaxiZahyo As Long = 999 017 '1ページに存在する文字列(単語)の最大数 018 Private Const MAX_GetText As Long = 32767 019 020 Private Enum JsZahyo 'JavaScriptから取得のQuads座標 021 iTop = 1 022 iBottom = 5 023 iLeft = 0 024 iRight = 2 025 End Enum 026 '※ 0[Left] 1[Top] 2[Right] 3[Top] 027 '※ 4[Left] 5[Bottom] 6[Right] 7[Bottom] 028 029 Private Enum Zahyo '四方座標 030 iTop = 0 031 iBottom = 1 032 iLeft = 2 033 iRight = 3 034 End Enum 035 036 Public Type typeTextRect 037 iPageNo As Long 'ページ番号 038 iSearchNo As Long 'sInSerchTextの配列番号:n 039 iLeft As Double '座標 Left 040 iRight As Double '座標 Right 041 iTop As Double '座標 Top 042 iBottom As Double '座標 Bottom 043 iRenzoku As Long '0=単独、 044 '1以上=連続するテキストの連番 045 iWordNo As Long 'JavaScriptでの単語の抽出番号 046 ' sText As String 'Debug Item 047 End Type 048 Public gTextRects() As typeTextRect 049 050 '************************************************** 051 ' 052 ' Get Texts and Rects from PDF Page 053 ' 054 ' Create : 2020/03/25 055 ' Update : 2020/04/30 056 ' Vertion : 2.0.7 057 ' 058 ' 引数1 : sInFilePathIn As String (IN) 059 ' 検索するPDFのフルパスdebu 060 ' 引数2 :lInPageStart As Long (IN) 061 ' 検索の開始ページ 062 ' 先頭ページは1です 063 ' -1は最初から検索 064 ' 引数3 :lInPageEnd As Long (IN) 065 ' 検索の終了ページ 066 ' -1で最終ページまで検索 067 ' 引数4 :sInSerchText(n) As String (IN) 068 ' 検索する文字列 069 ' 配列の最後又はテキスト無しを最後と判断 070 ' 引数5 :gTextRects()       (OUT) 071 ' 検索した結果 072 ' iPageNo :ページ番号 073 ' iSearchNo:sInSerchTextの配列番号のn 074 ' -1は当配列の終了を示す 075 ' iLeft  :座標 Left 076 ' iRight  :座標 Right 077 ' iTop   :座標 Top 078 ' iBottom :座標 Bottom 079 ' iRenzoku :連続するテキストの連番 080 ' iWordNo :JavaScriptで抽出した時の単語の番号 081 ' 引数6 :lOutCnt As Long (OUT) 082 ' sOutData の登録件数 083 ' 084 ' 戻り値 : True 正常処理 085 ' False エラー処理 PDFで無い 086 ' 087 ' グローバル変数とテキストファイルに実行結果が 088 ' 出力されます。 089 ' 090 ' 注意 : A)ページにまたがるテキストは検索しません。 091 ' B)半角は大文字小文字を区別します。 092 '  区別ナシは出来ません。 093 ' c)半角文字が複数行にまたがる時は改行無しで 094 '  検索されます。 095 ' 096 ' URL : https://pdf-file.nnn2.com/?p=1099 097 ' 098 ' 備考 :連続するテキストの座標で 099 ' 前のテキストの左端 > 次のテキストの右端 100 ' と言う座標が重なるケースが有る。 101 ' この場合は前のテキストの左端を強制的に修正する。 102 ' 詳細はロジック内の「補正」を参照。 103 ' 104 ' その他 : 著作権等は主張しません。 105 ' 上記URLにコメントを頂けると嬉しいです。 106 ' 107 '************************************************** 108 109 Public Function GetTextsGetRects( _ 110 ByVal sInFilePathIn As String, _ 111 ByVal lInPageStart As Long, _ 112 ByVal lInPageEnd As Long, _ 113 ByRef sInSerchText() As String, _ 114 ByRef gTextRects() As typeTextRect, _ 115 ByRef lOutCnt As Long) As Boolean 116 117 On Error GoTo Err_GetTextsGetRects: 118 119 '初期値 120 GetTextsGetRects = True 121 lOutCnt = 0 122 123 Dim i1 As Long 124 Dim i2 As Long 125 Dim i3 As Long 126 Dim i4 As Long 127 Dim iT1 As Long 128 Dim j As Long 129 Dim iOut As Long 130 Dim iPageNo As Long 131 Dim iPageCnt As Long 132 Dim iRet As Long 133 Dim bRet As Boolean 134 Dim iPageStart As Long 135 Dim iPageEnd As Long 136 137 Dim sPageTextAll As String 138 Dim sSearch_CutText As String '処理したテキストは削除 139 Dim sSearch_TextWK As String 140 Dim iSearch_HitCnt() As Long 141 Dim iSearch_TextLen As Long 142 Dim iSearch_SpaceCnt As Long 143 Dim iPageHitCnt As Long 144 Dim iCnt As Long 145 Dim iGetTextEnd As Long 146 Dim sText As String 147 Dim sText_Mae As String 148 Dim iText_AddCnt As Long 149 Dim iLenzoku As Long 150 Dim iWkZahyo(MaxiZahyo, 3) As Double 151 Dim sWk1 As String 152 Dim swk2() As String 153 154 Dim iLeft As Double '右の座標 155 Dim iRight As Double '左の座標 156 Dim iTop As Double '上の座標 157 Dim iBottom As Double '下の座標 158 Dim iRenzoku As Long 159 160 Dim sAJS As String 161 Dim sJsRet As String 162 Dim sJsWk1 As String 163 Dim sJsWk1Next As String 164 Dim sJsWk2() As String 165 Dim sJsWk3() As String 166 Dim sJsWk3Next() As String 167 Dim sJsWk4() As String 168 Dim sJsText(MAX_GetText) As String 169 Dim sJsZahyo(MAX_GetText, 7) As Double 170 171 Dim bCRLF As Boolean 172 Dim bCR As Boolean 173 Dim bLF As Boolean 174 Dim bSpace As Boolean 175 Dim iOver As Long 176 Dim iSame As Long 177 178 Const sAcrobatJavaScript = _ 179 "var sOut='';" & _ 180 "var numWords = this.getPageNumWords(@P);" & _ 181 "for ( var j = 0; j < numWords; j++) {" & _ 182 " nthWord = this.getPageNthWord(@P,j,false);" & _ 183 " aQuadsFirst = this.getPageNthWordQuads(@P,j);" & _ 184 " sOut=sOut + j + '\b' + nthWord + " & _ 185 "'\b' + aQuadsFirst + '\t';" & _ 186 "}" & _ 187 "event.value=sOut;" 188 '※上記の特殊文字はデータの区切りに使用 189 ' (\b:バックスペース)(\t:タブ) 190 191 If Dir$(sInFilePathIn, vbNormal) = "" Then 192 MsgBox sInFilePathIn & vbCrLf & _ 193 "ファイルが存在しない。", _ 194 vbOKOnly + vbCritical, "実行エラー" 195 GetTextsGetRects = False 196 Exit Function 197 End If 198 199 'Acrobatオブジェクトの定義&作成 200 '※ここのオブジェクトをグローバル変数にしては駄目! 201 ' Acrobat 7,8,9,10,11 の時 202 Dim objAcroApp As New Acrobat.AcroApp 203 Dim objAcroAVDoc As New Acrobat.AcroAVDoc 204 Dim objAcroPDDoc As New Acrobat.AcroPDDoc 205 Dim objAcroPDPage As Acrobat.AcroPDPage 206 Dim objAcroAVPageView As Acrobat.AcroAVPageView 207 Dim objAFormApp As AFORMAUTLib.AFormApp 208 Dim objAFormFields As AFORMAUTLib.Fields 209 Dim objAFormField As AFORMAUTLib.Field 210 211 If DEBUG_MODE Then Call Log_Start 212 213 objAcroApp.CloseAllDocs 214 objAcroApp.Hide '稀にデスクトップに表示されるので隠す 215 216 'PDFファイルを開く 217 If objAcroAVDoc.Open(sInFilePathIn, "") = False Then 218 MsgBox "Open出来ません。" & vbCrLf & sInFilePathIn, _ 219 vbOKOnly + vbCritical, "実行エラー" 220 GetTextsGetRects = False 221 GoTo Skip_GetTextsGetRects_END: 222 End If 223 224 Application.Cursor = xlWait 'マウスポインターを砂時計 225 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc 226 iPageStart = IIf(lInPageStart = -1, 0, lInPageStart - 1) 227 iPageEnd = IIf(lInPageEnd = -1, objAcroPDDoc.GetNumPages, lInPageEnd) - 1 228 229 iOut = 0 230 ReDim iSearch_HitCnt(UBound(sInSerchText)) As Long 231 232 Set objAFormApp = CreateObject("AFormAut.App") 233 Set objAFormFields = objAFormApp.Fields 234 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc 235 236 For iPageNo = iPageStart To iPageEnd 237 238 If DEBUG_MODE Then Debug.Print _ 239 "処理の開始ページ-" & iPageNo + 1 & " : " & Time 240 DoEvents 241 242 '▼<JS>頁の全文字列を抽出 243 'Acrobat JavaScriptの編集 244 sAJS = sAcrobatJavaScript 245 sAJS = Replace(sAJS, "@P", iPageNo) 246 'Acrobat JavaScript の実行 247 sJsRet = objAFormFields.ExecuteThisJavascript(sAJS) 248 Erase sJsText '初期化 249 Erase sJsZahyo '初期化 250 sJsWk2 = Split(sJsRet, vbTab) 251 sPageTextAll = "" 252 For i1 = 0 To UBound(sJsWk2) 253 If sJsWk2(i1) = "" Then Exit For 254 sJsWk3 = Split(sJsWk2(i1), vbBack) 255 sJsWk1 = sJsWk3(1) 256 257 bSpace = (InStr(sJsWk1, " ") > 0) 258 bCRLF = (InStr(sJsWk1, vbCrLf) > 0) 259 bCR = (InStr(sJsWk1, vbCr) > 0) 260 bLF = (InStr(sJsWk1, vbLf) > 0) 261 262 '★次に繋がる半角文字の処理 263 If CONTINUOUS_STRING Then 264 If bCRLF Or bLF Or bCR Then 265 If i1 < UBound(sJsWk2) And sJsWk2(i1 + 1) <> "" Then 266 If Len(sJsWk1) = _ 267 LenB(StrConv(sJsWk1, vbFromUnicode)) Then 268 '半角文字列 269 sJsWk3Next = Split(sJsWk2(i1 + 1), vbBack) 270 sJsWk1Next = sJsWk3Next(1) 271 If Len(sJsWk1Next) = _ 272 LenB(StrConv(sJsWk1Next, vbFromUnicode)) Then 273 '※行の最後の文字列と次行の文字列が共に 274 ' 半角文字の時は連続文字として扱う。 275 ' よって、最後の空白は削除する。 276 sJsWk1 = Replace(sJsWk1, " ", "") 277 End If 278 End If 279 End If 280 End If 281 End If 282 'テキスト 283 sJsWk1 = Replace(sJsWk1, vbLf, "") 284 sJsWk1 = Replace(sJsWk1, vbCr, "") 285 sJsWk1 = Replace(sJsWk1, vbCrLf, "") 286 sJsText(i1) = sJsWk1 'ココではReplace(sJsWk1, " ", "")しない 287 '座標 288 sJsWk4 = Split(sJsWk3(2), ",") 289 For i2 = 0 To 7 290 sJsZahyo(i1, i2) = sJsWk4(i2) 291 Next i2 292 293 '★<(補正) PDF内の座標不良を強制的に修正 294 ' ※座標がクロスする部分が有る為 295 If MODIFY_THE_COORDINATES And 0 < i1 Then 296 If sJsZahyo(i1 - 1, JsZahyo.iTop) = sJsZahyo(i1, JsZahyo.iTop) And _ 297 sJsZahyo(i1 - 1, JsZahyo.iBottom) = sJsZahyo(i1, JsZahyo.iBottom) Then 298 If sJsZahyo(i1 - 1, JsZahyo.iRight) < sJsZahyo(i1, JsZahyo.iRight) Then 299 If sJsZahyo(i1 - 1, JsZahyo.iRight) > sJsZahyo(i1, JsZahyo.iLeft) Then 300 If DEBUG_MODE Then _ 301 Call Put_Degug_log(i1 - 1 & " ★Over " & _ 302 sJsZahyo(i1 - 1, JsZahyo.iRight) & _ 303 " <= " & sJsZahyo(i1, JsZahyo.iLeft) & " (" & _ 304 Format(sJsZahyo(i1 - 1, JsZahyo.iRight) - _ 305 sJsZahyo(i1, JsZahyo.iLeft), "0.0000000") & ")") 306 '同じに補正する。 307 sJsZahyo(i1 - 1, JsZahyo.iRight) = sJsZahyo(i1, JsZahyo.iLeft) 308 iOver = iOver + 1 309 ElseIf sJsZahyo(i1 - 1, JsZahyo.iRight) = sJsZahyo(i1, JsZahyo.iLeft) Then 310 If DEBUG_MODE Then _ 311 Call Put_Degug_log(i1 - 1 & " ★Same " & _ 312 sJsZahyo(i1 - 1, JsZahyo.iRight) & _ 313 " = " & sJsZahyo(i1, JsZahyo.iLeft)) 314 iSame = iSame + 1 315 End If 316 End If 317 End If 318 End If 319 '★> 320 321 sPageTextAll = sPageTextAll & sJsText(i1) 322 iGetTextEnd = i1 323 324 If DEBUG_MODE Then 325 Call Put_Degug_log( _ 326 "Page=" & iPageNo & " " & _ 327 " [" & sJsWk3(0) & "] (" & _ 328 sJsWk1 & ") " & _ 329 IIf(bSpace, "-Space", "") & _ 330 IIf(bCRLF, "-CRLF", "") & _ 331 IIf(bCR, "-CR", "") & _ 332 IIf(bLF, "-LF", "") & _ 333 " Top[" & sJsWk4(1) & "] Bottom[" & _ 334 sJsWk4(5) & "] Left[" & sJsWk4(0) & _ 335 "] Right[" & sJsWk4(2) & "]") 336 End If 337 '※ 0[Left] 1[Top] 2[Right] 3[Top] 338 '※ 4[Left] 5[Bottom] 6[Right] 7[Bottom] 339 Next i1 340 341 342 '▼検索文字列が頁内に存在するかチェック 343 iPageHitCnt = 0 344 For i3 = 0 To UBound(sInSerchText) 345 swk2 = Split(sPageTextAll, sInSerchText(i3)) 346 iPageHitCnt = iPageHitCnt + UBound(swk2) 347 iSearch_HitCnt(i3) = UBound(swk2) 348 If DEBUG_MODE Then Debug.Print "sInSerchText(" & _ 349 i3 & ")=" & sInSerchText(i3) & " Hit(" & _ 350 iSearch_HitCnt(i3) & ")" 351 Next i3 352 If iPageHitCnt = 0 Then GoTo Skip_Next_Page: 353 354 '▼該当する文字列が有る 355 DoEvents 356 iLenzoku = 0 357 iRenzoku = 0 358 359 For iT1 = 0 To UBound(sInSerchText) 360 361 If iSearch_HitCnt(iT1) = 0 Then GoTo Skip_Next_iT1: 362 363 sSearch_TextWK = sInSerchText(iT1) 364 iSearch_SpaceCnt = UBound(Split(sInSerchText(iT1), " ")) 365 iSearch_TextLen = Len(sSearch_TextWK) 366 367 For i1 = 0 To iGetTextEnd 368 sText = "" 369 iText_AddCnt = 0 370 sSearch_CutText = sSearch_TextWK 371 372 For i2 = i1 To iGetTextEnd 373 sText = sText & sJsText(i2) 374 iText_AddCnt = iText_AddCnt + 1 375 If iText_AddCnt >= MaxiZahyo Then 376 MsgBox "プログラミング的なエラーが発生しました。" & _ 377 vbCrLf & "原因:iText_AddCnt が制限を越えました。" & _ 378 vbCrLf & "処理は強制終了します。", _ 379 vbCritical, "実行エラー" 380 GetTextsGetRects = False 381 Stop '強制中断 382 GoTo Skip_GetTextsGetRects_END: 383 End If 384 If iSearch_SpaceCnt <> 0 Then 385 If iText_AddCnt <= iSearch_SpaceCnt Then 386 GoTo Skip_Next_i2: 387 End If 388 End If 389 390 If Len(sText) >= iSearch_TextLen Then 391 392 If InStr(sText, sSearch_CutText) = 0 Then Exit For 393 394 If Len(sJsText(i1)) >= InStr(sText, sSearch_CutText) Then 395 'sJsText(i1)の文字列から検索キーが始まっている 396 397 '▼四方座標を取得 Start 398 For i4 = 0 To iText_AddCnt - 1 399 iWkZahyo(i4, Zahyo.iTop) = _ 400 sJsZahyo(i1 + i4, JsZahyo.iTop) 401 iWkZahyo(i4, Zahyo.iBottom) = _ 402 sJsZahyo(i1 + i4, JsZahyo.iBottom) 403 iWkZahyo(i4, Zahyo.iLeft) = _ 404 sJsZahyo(i1 + i4, JsZahyo.iLeft) 405 iWkZahyo(i4, Zahyo.iRight) = _ 406 sJsZahyo(i1 + i4, JsZahyo.iRight) 407 Next i4 408 '▼四方座標を取得 End 409 410 iLeft = -1 411 For i4 = 0 To iText_AddCnt - 1 412 If i4 = iText_AddCnt - 1 Then 413 '最後(最終行)の処理 414 iTop = iWkZahyo(i4, Zahyo.iTop) 415 iBottom = iWkZahyo(i4, Zahyo.iBottom) 416 '>:右の座標 417 If InStr(sText, sSearch_CutText) = 1 Then 418 '検索キーは先頭から有る 419 If iLeft = -1 Then _ 420 iLeft = iWkZahyo(i4, Zahyo.iLeft) 421 Else 422 '後ろのスペースをカット 423 sText = Replace(sText, " ", "") 424 '検索キーは2桁以降から始まる 425 iLeft = iWkZahyo(i4, Zahyo.iLeft) + _ 426 ((iWkZahyo(i4, Zahyo.iRight) - _ 427 iWkZahyo(i4, Zahyo.iLeft)) / _ 428 Len(sText) * _ 429 (InStr(sText, sSearch_CutText) - 1)) 430 End If 431 '<:左の座標 432 If Len(sText) = Len(sSearch_CutText) Or _ 433 sText = sSearch_CutText & Space(1) Then 434 '検索キーの終端は最後に有る 435 iRight = iWkZahyo(i4, Zahyo.iRight) 436 Else 437 '後ろのスペースをカット 438 sText = Replace(sText, " ", "") 439 '検索キーの終端は最後から前に有る 440 iRight = iWkZahyo(i4, Zahyo.iLeft) + _ 441 ((iWkZahyo(i4, Zahyo.iRight) - _ 442 iWkZahyo(i4, Zahyo.iLeft)) / _ 443 Len(sText) * _ 444 (InStr(sText, sSearch_CutText) + _ 445 (Len(sSearch_CutText) - 1))) 446 End If 447 '■座標情報を出力 448 If iRenzoku <> 0 Then iRenzoku = iRenzoku + 1 449 With gTextRects(iOut) 450 .iSearchNo = iT1 451 .iPageNo = iPageNo 452 .iTop = iTop 453 .iBottom = iBottom 454 .iLeft = iLeft 455 .iRight = iRight 456 .iRenzoku = iRenzoku 457 .iWordNo = i1 + i4 458 ' .sText = sInSerchText(iT1) 'Debug Item 459 End With 460 iRenzoku = 0 461 462 iOut = iOut + 1 463 iSearch_HitCnt(iT1) = iSearch_HitCnt(iT1) - 1 464 i2 = iGetTextEnd '次のキー検索に進ませる 465 iLeft = -1 466 Exit For 467 End If 468 469 '※小数点以下の差は同じとする。 470 If Abs(iWkZahyo(i4, Zahyo.iTop) - _ 471 iWkZahyo(i4 + 1, Zahyo.iTop)) < _ 472 CON_LINE_VARIATION And _ 473 Abs(iWkZahyo(i4, Zahyo.iBottom) - _ 474 iWkZahyo(i4 + 1, Zahyo.iBottom)) < _ 475 CON_LINE_VARIATION Then 476 '次は同じ行 477 If iLeft = -1 Then 478 If InStr(sText, sSearch_CutText) = 1 Then 479 iLeft = iWkZahyo(i4, Zahyo.iLeft) 480 Else 481 iLeft = iWkZahyo(i4, Zahyo.iLeft) + _ 482 ((iWkZahyo(i4, Zahyo.iRight) - _ 483 iWkZahyo(i4, Zahyo.iLeft)) / _ 484 Len(sJsText(i1 + i4)) * _ 485 (InStr(sText, sSearch_CutText) - 1)) 486 End If 487 End If 488 Else 489 '次は別の行 490 iTop = iWkZahyo(i4, Zahyo.iTop) 491 iBottom = iWkZahyo(i4, Zahyo.iBottom) 492 '>:右の座標 493 If InStr(sText, sSearch_CutText) = 1 Then 494 '検索キーは先頭から有る 495 If iLeft = -1 Then _ 496 iLeft = iWkZahyo(i4, Zahyo.iLeft) 497 Else 498 '検索キーは2桁以降から始まる 499 iLeft = iWkZahyo(i4, Zahyo.iLeft) + _ 500 ((iWkZahyo(i4, Zahyo.iRight) - _ 501 iWkZahyo(i4, Zahyo.iLeft)) / _ 502 Len(sJsText(i1 + i4)) * _ 503 (InStr(sText, sSearch_CutText) - 1)) 504 End If 505 '<:左の座標 506 iRight = iWkZahyo(i4, Zahyo.iRight) 507 508 '■座標情報を出力 509 iRenzoku = iRenzoku + 1 510 With gTextRects(iOut) 511 .iSearchNo = iT1 512 .iPageNo = iPageNo 513 .iTop = iTop 514 .iBottom = iBottom 515 .iLeft = iLeft 516 .iRight = iRight 517 .iRenzoku = iRenzoku 518 .iWordNo = i1 + i4 519 ' .sText = sInSerchText(iT1) 'Debug Item 520 End With 521 522 iOut = iOut + 1 523 iSearch_HitCnt(iT1) = iSearch_HitCnt(iT1) - 1 524 iLeft = -1 525 End If 526 '処理済みの文字列は取り除く 527 sWk1 = sText 528 sText = Mid$(sWk1, Len(sJsText(i1 + i4)) + 1) 529 sSearch_CutText = Mid$(sSearch_CutText, _ 530 Len(sJsText(i1 + i4)) - _ 531 InStr(sWk1, sSearch_CutText) + 2) 532 Next i4 533 Else 534 If Len(sText) >= iSearch_TextLen Then Exit For 535 End If 536 End If 537 Skip_Next_i2: 538 Next i2 539 Next i1 540 Skip_Next_iT1: 541 Next iT1 542 Skip_Next_Page: 543 Next iPageNo 544 545 gTextRects(iOut).iSearchNo = -1 546 Application.Cursor = xlDefault 'マウスポインターを戻す 547 'PDFファイルを閉じる 548 If objAcroAVDoc.Close(False) = False Then 549 MsgBox "AVDocオブジェクトはClose出来ませんでした", _ 550 vbOKOnly + vbCritical, "実行エラー" 551 GetTextsGetRects = False 552 End If 553 554 Skip_GetTextsGetRects_END: 555 556 On Error Resume Next 'これ以降は強制実行 557 558 Application.Cursor = xlDefault 'マウスポインターを戻す 559 '変更しないで閉じます。 560 bRet = objAcroAVDoc.Close(False) 561 'Acrobatアプリケーションの終了 562 objAcroApp.Hide 563 objAcroApp.Exit 564 'オブジェクトの開放 565 Set objAFormFields = Nothing 566 Set objAFormField = Nothing 567 Set objAFormApp = Nothing 568 Set objAcroAVPageView = Nothing 569 Set objAcroPDPage = Nothing 570 Set objAcroPDDoc = Nothing 571 Set objAcroAVDoc = Nothing 572 Set objAcroApp = Nothing 573 574 lOutCnt = iOut '出力件数 575 If DEBUG_MODE Then 576 Debug.Print "iOver=" & iOver 577 Debug.Print "iSame=" & iSame 578 Call Run_NOTEPAD 579 End If 580 581 Exit Function 582 583 Err_GetTextsGetRects: 584 MsgBox "処理は以下の理由で中断しました。" & vbCrLf & _ 585 vbCrLf & Err.Number & vbCrLf & Err.Description, _ 586 vbOKOnly + vbCritical, "実行エラー" 587 GetTextsGetRects = False 588 GoTo Skip_GetTextsGetRects_END: 589 End Function


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

 

1. サンプル:ハイライト表示「Highlight」

検索テキストが複数行(列)にまたがる場合が有ります。その場合は引数 gTextRects(i1).iRenzoku の値が1からの連番になります。この使い方に注意してください。

  • 「注釈:ハイライト表示の追加、削除、変更」(※後日、追加予定)に詳細を書いています。
001 Option Explicit 002 003 'Debug Mode True:オン False:オフ 004 Private Const DEBUG_MODE As Boolean = False 005 006 '************************************************** 007 ' 008 ' 関数をテストする為の呼び出しルーチン 009 ' 010 ' 関数を呼び出し後、結果を確認する為に、 011 ' 座標からPDFに注釈を貼り付ける。 012 ' 013 ' Create : 2020/03/25 014 ' Update : 2020/04/09 015 ' Vertion : 1.0.1 016 ' 017 '************************************************** 018 019 Sub Test_Main_Highlight() 020 021 Dim start As Double: start = Timer 022 023 Dim i1 As Long 024 Dim bRet As Boolean 025 Dim sFilePathIn As String 026 Dim iOutCnt As Long 027 Dim sInSerchText() As String 028 ReDim sInSerchText(19) As String 029 ReDim gTextRects(500) As typeTextRect 030 031 Const CON_TEST = 1 032 033 If CON_TEST = 1 Then 034 i1 = 0 035 sInSerchText(i1) = "ATA": i1 = i1 + 1 036 sInSerchText(i1) = "ス63": i1 = i1 + 1 037 sInSerchText(i1) = "Windows": i1 = i1 + 1 038 sInSerchText(i1) = "Home 64": i1 = i1 + 1 039 sInSerchText(i1) = "10": i1 = i1 + 1 040 sInSerchText(i1) = "8GB": i1 = i1 + 1 041 sInSerchText(i1) = "USB": i1 = i1 + 1 042 sInSerchText(i1) = "HDD": i1 = i1 + 1 043 sInSerchText(i1) = "i5-9400": i1 = i1 + 1 044 sInSerchText(i1) = "RAM": i1 = i1 + 1 045 sInSerchText(i1) = "音電": i1 = i1 + 1 046 sInSerchText(i1) = "6ス": i1 = i1 + 1 047 sInSerchText(i1) = "ル)": i1 = i1 + 1 048 sInSerchText(i1) = "Adobe": i1 = i1 + 1 049 sInSerchText(i1) = "Acrobat": i1 = i1 + 1 050 sInSerchText(i1) = "JavaScript": i1 = i1 + 1 051 sInSerchText(i1) = "Get": i1 = i1 + 1 052 sInSerchText(i1) = "getPage": i1 = i1 + 1 053 sInSerchText(i1) = "Common Dialog Control": i1 = i1 + 1 054 sInSerchText(i1) = "Text""annot": i1 = i1 + 1 055 sFilePathIn = ThisWorkbook.Path & "\test-002.pdf" 056 Else 057 i1 = 0 058 sInSerchText(i1) = "文目": i1 = i1 + 1 059 sInSerchText(i1) = "ビューア": i1 = i1 + 1 060 sInSerchText(i1) = "文字や図形や画像": i1 = i1 + 1 061 sInSerchText(i1) = "Acrobat Reader": i1 = i1 + 1 062 sInSerchText(i1) = "テキスト": i1 = i1 + 1 063 sInSerchText(i1) = "構成する様々な要素": i1 = i1 + 1 064 sInSerchText(i1) = "%PDF-1.2": i1 = i1 + 1 065 sInSerchText(i1) = "Acrobat": i1 = i1 + 1 066 sInSerchText(i1) = "がPDF": i1 = i1 + 1 067 sInSerchText(i1) = "<</Type": i1 = i1 + 1 068 'sInSerchText(i1) = "<< /Type": i1 = i1 + 1 069 sFilePathIn = ThisWorkbook.Path & "\手書きPDF入門-4.pdf" 070 End If 071 072 bRet = GetTextsGetRects(sFilePathIn, -1, -1, _ 073 sInSerchText, gTextRects, iOutCnt) 074 075 '******************************************** 076 '▼ これ以降は結果を確認する為のロジック ▼ 077 '******************************************** 078 079 On Error Resume Next 080 Dim sWk As String 081 Dim sWkCon As String 082 Dim sQuads As String 083 Dim i2 As Long 084 Dim sAJS As String 085 Dim sReturn As String 086 Dim objAcroApp As New Acrobat.AcroApp 087 Dim objAcroAVDoc As New Acrobat.AcroAVDoc 088 Dim objAcroPDDoc As New Acrobat.AcroPDDoc 089 Dim objAcroPDPage As Acrobat.AcroPDPage 090 Dim objAcroAVPageView As Acrobat.AcroAVPageView 091 Dim objAFormApp As AFORMAUTLib.AFormApp 092 Dim objAFormFields As AFORMAUTLib.Fields 093 094 objAcroApp.CloseAllDocs 095 objAcroApp.Hide '稀にデスクトップに表示されるので隠す 096 'PDFファイルを開く 097 bRet = objAcroAVDoc.Open(sFilePathIn, "") 098 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc 099 Set objAFormApp = CreateObject("AFormAut.App") 100 Set objAFormFields = objAFormApp.Fields 101 102 Const sAcrobatJavaScript3 = _ 103 "oRet = this.addAnnot({" & _ 104 " type:'Highlight' ," & _ 105 " quads:[@q] ," & _ 106 " page:@p ," & _ 107 " strokeColor:@c ," & _ 108 "}); " 109 ' " contents:'@t', " & _ 110 ' " author:'@A' ," & _ 111 112 If DEBUG_MODE Then 113 Call Put_Degug_log("") 114 For i1 = 0 To iOutCnt 115 With gTextRects(i1) 116 If .iSearchNo = -1 Then Exit For 117 sWk = sInSerchText(.iSearchNo) 118 Call Put_Degug_log( _ 119 "Text(" & i1 & ")=[" & sWk & _ 120 "] SIndex=" & .iSearchNo & _ 121 " Page=" & .iPageNo & _ 122 " WordNo=" & .iWordNo & _ 123 " Top=" & .iTop & _ 124 " Bottom=" & .iBottom & _ 125 " Left=" & .iLeft & _ 126 " Right=" & .iRight) 127 End With 128 Next i1 129 End If 130 131 For i1 = 0 To iOutCnt 132 With gTextRects(i1) 133 If .iSearchNo = -1 Then Exit For 134 sWk = Replace(sInSerchText(.iSearchNo), "'", "''") 135 sWkCon = "Text=[" & sWk & "] " & _ 136 " WNo=" & .iWordNo & _ 137 " Top=" & .iTop & _ 138 " Bottom=" & .iBottom & _ 139 " Left=" & .iLeft & _ 140 " Right=" & .iRight 141 End With 142 143 sAJS = sAcrobatJavaScript3 144 sQuads = "" 145 If gTextRects(i1).iRenzoku = 0 Then 146 '一列のみのハイライト表示 147 With gTextRects(i1) 148 sQuads = sQuads & "[" & _ 149 .iLeft & "," & _ 150 .iTop & "," & _ 151 .iRight & "," & _ 152 .iTop & "," & _ 153 .iLeft & "," & _ 154 .iBottom & "," & _ 155 .iRight & "," & _ 156 .iBottom & "]" 157 End With 158 sAJS = Replace(sAJS, "@q", sQuads) 159 Else 160 '複数列にまたがるハイライト表示 161 For i2 = i1 To iOutCnt 162 If sQuads <> "" Then sQuads = sQuads & "," 163 With gTextRects(i2) 164 sQuads = sQuads & "[" & _ 165 .iLeft & "," & _ 166 .iTop & "," & _ 167 .iRight & "," & _ 168 .iTop & "," & _ 169 .iLeft & "," & _ 170 .iBottom & "," & _ 171 .iRight & "," & _ 172 .iBottom & "]" 173 End With 174 '※ 0[Left] 1[Top] 2[Right] 3[Top] 175 '※ 4[Left] 5[Bottom] 6[Right] 7[Bottom] 176 If i2 + 1 > iOutCnt Then 177 '最終 178 i1 = iOutCnt 179 sAJS = Replace(sAJS, "@q", sQuads) 180 Exit For 181 End If 182 If gTextRects(i2 + 1).iRenzoku <= 1 Then 183 i1 = i2 184 sAJS = Replace(sAJS, "@q", sQuads) 185 Exit For 186 End If 187 Next i2 188 End If 189 sAJS = Replace(sAJS, "@c", "color.yellow") 190 sAJS = Replace(sAJS, "@p", gTextRects(i1).iPageNo) 191 sAJS = Replace(sAJS, "@t", sWkCon) 192 193 '■Acrobat JavaScript の実行 194 sReturn = objAFormFields.ExecuteThisJavascript(sAJS) 195 Next i1 196 197 'PDFファイルを別名で保存 198 Dim sFilePathOut As String 199 sFilePathOut = Replace(sFilePathIn, ".pdf", "-Highlight.pdf") 200 If objAcroPDDoc.Save(1, sFilePathOut) = False Then 201 MsgBox "PDFファイルへ保存出来ませんでした", _ 202 vbOKOnly + vbCritical, "実行エラー" 203 End If 204 '変更しないで閉じます。 205 bRet = objAcroAVDoc.Close(False) 206 'Acrobatアプリケーションの終了 207 objAcroApp.Hide 208 objAcroApp.Exit 209 'オブジェクトの開放 210 Set objAcroAVPageView = Nothing 211 Set objAcroPDPage = Nothing 212 Set objAcroAVDoc = Nothing 213 Set objAFormApp = Nothing 214 Set objAFormFields = Nothing 215 Set objAcroApp = Nothing 216 217 Debug.Print "出力件数 = " & iOutCnt 218 Debug.Print "処理時間 = " & Timer - start 219 220 If DEBUG_MODE Then Call Run_NOTEPAD 221 End Sub


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

上記の実行結果です。

 

2. サンプル:長方形の注釈「Square」

注釈のテキストには座標の内容を入れました。

001 Option Explicit 002 003 'Debug Mode True:オン False:オフ 004 Private Const DEBUG_MODE As Boolean = False 005 006 '************************************************** 007 ' 008 ' 関数をテストする為の呼び出しルーチン 009 ' 010 ' 関数を呼び出し後、結果を確認する為に、 011 ' 座標からPDFに注釈を貼り付ける。 012 ' 013 ' Create : 2020/03/25 014 ' Update : 2020/04/09 015 ' Vertion : 1.0.1 016 ' 017 '************************************************** 018 019 Sub Test_Main_Square() 020 021 Dim start As Double: start = Timer 022 023 Dim i1 As Long 024 Dim bRet As Boolean 025 Dim sFilePathIn As String 026 Dim iOutCnt As Long 027 Dim sInSerchText() As String 028 ReDim sInSerchText(19) As String 029 ReDim gTextRects(500) As typeTextRect 030 031 Const CON_TEST = 1 032 033 If CON_TEST = 1 Then 034 i1 = 0 035 sInSerchText(i1) = "ATA": i1 = i1 + 1 036 sInSerchText(i1) = "ス63": i1 = i1 + 1 037 sInSerchText(i1) = "Windows": i1 = i1 + 1 038 sInSerchText(i1) = "Home 64": i1 = i1 + 1 039 sInSerchText(i1) = "10": i1 = i1 + 1 040 sInSerchText(i1) = "8GB": i1 = i1 + 1 041 sInSerchText(i1) = "USB": i1 = i1 + 1 042 sInSerchText(i1) = "HDD": i1 = i1 + 1 043 sInSerchText(i1) = "i5-9400": i1 = i1 + 1 044 sInSerchText(i1) = "RAM": i1 = i1 + 1 045 sInSerchText(i1) = "音電": i1 = i1 + 1 046 sInSerchText(i1) = "6ス": i1 = i1 + 1 047 sInSerchText(i1) = "ル)": i1 = i1 + 1 048 sInSerchText(i1) = "Adobe": i1 = i1 + 1 049 sInSerchText(i1) = "Acrobat": i1 = i1 + 1 050 sInSerchText(i1) = "JavaScript": i1 = i1 + 1 051 sInSerchText(i1) = "Get": i1 = i1 + 1 052 sInSerchText(i1) = "getPage": i1 = i1 + 1 053 sInSerchText(i1) = "Common Dialog Control": i1 = i1 + 1 054 sInSerchText(i1) = "Text""annot": i1 = i1 + 1 055 sFilePathIn = ThisWorkbook.Path & "\test-002.pdf" 056 Else 057 i1 = 0 058 sInSerchText(i1) = "文目": i1 = i1 + 1 059 sInSerchText(i1) = "ビューア": i1 = i1 + 1 060 sInSerchText(i1) = "文字や図形や画像": i1 = i1 + 1 061 sInSerchText(i1) = "Acrobat Reader": i1 = i1 + 1 062 sInSerchText(i1) = "テキスト": i1 = i1 + 1 063 sInSerchText(i1) = "構成する様々な要素": i1 = i1 + 1 064 sInSerchText(i1) = "%PDF-1.2": i1 = i1 + 1 065 sInSerchText(i1) = "Acrobat": i1 = i1 + 1 066 sInSerchText(i1) = "がPDF": i1 = i1 + 1 067 sInSerchText(i1) = "<</Type": i1 = i1 + 1 'VBAの検索 068 'sInSerchText(i1) = "<< /Type": i1 = i1 + 1 '手での検索 069 sFilePathIn = ThisWorkbook.Path & "\手書きPDF入門-4.pdf" 070 End If 071 072 bRet = GetTextsGetRects(sFilePathIn, -1, -1, _ 073 sInSerchText, gTextRects, iOutCnt) 074 075 '******************************************** 076 '▼ これ以降は結果を確認する為のロジック ▼ 077 '******************************************** 078 079 On Error Resume Next 080 Dim sWk As String 081 Dim sWkCon As String 082 Dim sQuads As String 083 Dim i2 As Long 084 Dim sAJS As String 085 Dim sReturn As String 086 Dim objAcroApp As New Acrobat.AcroApp 087 Dim objAcroAVDoc As New Acrobat.AcroAVDoc 088 Dim objAcroPDDoc As New Acrobat.AcroPDDoc 089 Dim objAcroPDPage As Acrobat.AcroPDPage 090 Dim objAcroAVPageView As Acrobat.AcroAVPageView 091 Dim objAFormApp As AFORMAUTLib.AFormApp 092 Dim objAFormFields As AFORMAUTLib.Fields 093 094 objAcroApp.CloseAllDocs 095 objAcroApp.Hide '稀にデスクトップに表示されるので隠す 096 'PDFファイルを開く 097 bRet = objAcroAVDoc.Open(sFilePathIn, "") 098 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc 099 Set objAFormApp = CreateObject("AFormAut.App") 100 Set objAFormFields = objAFormApp.Fields 101 102 Const sAcrobatJavaScript2 = _ 103 "oRet = this.addAnnot({" & _ 104 " type: ""Square"" ," & _ 105 " rect:[@1,@2,@3,@4] ," & _ 106 " page:@p ," & _ 107 " strokeColor:color.blue ," & _ 108 " width:0.3 ," & _ 109 " contents:'@t'," & _ 110 "}); " 111 112 If DEBUG_MODE Then 113 Call Put_Degug_log("") 114 For i1 = 0 To iOutCnt 115 With gTextRects(i1) 116 If .iSearchNo = -1 Then Exit For 117 sWk = sInSerchText(.iSearchNo) 118 Call Put_Degug_log( _ 119 "Text(" & i1 & ")=[" & sWk & _ 120 "] SIndex=" & .iSearchNo & _ 121 " Page=" & .iPageNo & _ 122 " WordNo=" & .iWordNo & _ 123 " Top=" & .iTop & _ 124 " Bottom=" & .iBottom & _ 125 " Left=" & .iLeft & _ 126 " Right=" & .iRight) 127 End With 128 Next i1 129 End If 130 131 For i1 = 0 To iOutCnt 132 With gTextRects(i1) 133 If .iSearchNo = -1 Then Exit For 134 sWk = Replace(sInSerchText(.iSearchNo), "'", "''") 135 sWkCon = "Text=[" & sWk & "] " & _ 136 " WNo=" & .iWordNo & _ 137 " Top=" & .iTop & _ 138 " Bottom=" & .iBottom & _ 139 " Left=" & .iLeft & _ 140 " Right=" & .iRight 141 sAJS = sAcrobatJavaScript2 142 sAJS = Replace(sAJS, "@1", .iLeft) 143 sAJS = Replace(sAJS, "@2", .iBottom) 144 sAJS = Replace(sAJS, "@3", .iRight) 145 sAJS = Replace(sAJS, "@4", .iTop) 146 sAJS = Replace(sAJS, "@p", .iPageNo) 147 End With 148 sAJS = Replace(sAJS, "@t", sWkCon) 149 150 '■Acrobat JavaScript の実行 151 sReturn = objAFormFields.ExecuteThisJavascript(sAJS) 152 Next i1 153 154 'PDFファイルを別名で保存 155 Dim sFilePathOut As String 156 sFilePathOut = Replace(sFilePathIn, ".pdf", "-Square.pdf") 157 If objAcroPDDoc.Save(1, sFilePathOut) = False Then 158 MsgBox "PDFファイルへ保存出来ませんでした", _ 159 vbOKOnly + vbCritical, "実行エラー" 160 End If 161 '変更しないで閉じます。 162 bRet = objAcroAVDoc.Close(False) 163 'Acrobatアプリケーションの終了 164 objAcroApp.Hide 165 objAcroApp.Exit 166 'オブジェクトの開放 167 Set objAcroAVPageView = Nothing 168 Set objAcroPDPage = Nothing 169 Set objAcroAVDoc = Nothing 170 Set objAFormApp = Nothing 171 Set objAFormFields = Nothing 172 Set objAcroApp = Nothing 173 174 Debug.Print "出力件数 = " & iOutCnt 175 Debug.Print "処理時間 = " & Timer - start 176 177 If DEBUG_MODE Then Call Run_NOTEPAD 178 End Sub


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

上記の実行結果です。

 

複数行にまたがる座標

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

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

関数の引数 gTextRects(x).iRenzoku には以下の値が返されます。

  • 「構成する」:1
  • 「様々な要素」:2

単独の場合はgTextRects(x).iRenzoku の値は0です。

  • 「注釈:ハイライト表示の追加、削除、変更」(※後日、追加予定)に詳細を書いています。

 

半角テキストでの検索

以下を御覧ください。

半角テキストの「<<」と「/Type」は行が違います。しかしテキスト検索では間に1つの空白入の「<< /Type」ではOKで、空白無し「<</Type」ではNGになります。間に1つの空白が無いと検索できません。

しかし、上記以外で行が異なるのに空白が有ると検索できないケースも有ります。検証しましたが、違いを見つけることが出来ませんでした。

とはいえ、改行時の検索方法を統一する必要があります。検索できないよりは検索できる方を優先します。よって、上記のケースの場合は連続した文字列として扱うことにしました。つまり空白無しの「<</Type」で当関数では検索可能とします。

Acrobat Reader」で検索する場合は改行も考慮して「AcrobatReader」も検索テキストに追加してください。

改行時に連続した文字列としての検索をしないで欲しい時は、関数内部の定数

Private Const CONTINUOUS_STRING As Boolean = True

の最後を True から False に変更してください。

 

座標の値が正確に出ない場合

Acrobat OLE も Acrobat JavaScript も以下の単位でテキストの座標を返します。

  • 半角 :空白、記号、改行等を区切りにした文字列のテキスト
    ※メーカー公開マニュアルではこれを単語と言います。
  • 全角 :1文字(1テキスト)単位

以下を見てください。テキスト「Acrobat」で検索し、その座標に長方形の注釈を付けました。

「Acrobat」の「t」が外側にあります。これは「Acrobat!」を1つの単語として座標を返してきたからです。後の文字の幅が異なるために、文字数で座標の再計算をすると「t」が外に出てしまいます。

1文字の幅が同じ等幅フォントの場合は再計算で正確な位置が出せます。しかし、プロポーショナルフォント (又は可変幅フォント)では文字毎に文字幅が異なります。

回避できない訳では無いですが、そのためにはフォントを意識した膨大なロジックを追加する必要が有ります。(パス!無理!

絶対イヤだ!と言う方は、座標に1ポイント程度のマージンを追加してみてください。

 

座標の値が重なる

当関数ではデフォルトで前のテキストの右端の値が次のテキストの左端に重なる場合、前のテキストの右端の値に次の左端の値を強制的に置き換えるようにしています。そうしないと座標計算が出来ない場合が多々発生します。詳細はコチラを御覧ください。

それでも強制的に置き換えたくない場合は、当関数に定義している定数

Private Const MODIFY_THE_COORDINATES As Boolean = True

上記をFalseに変更して下さい。

 

参照

 

備考

  • 座標の再計算はかなり複雑でデバッグが大変でした。後々の事も考えて、長くなっても変数名は分かりやすくしています。

 

 


 

管理者の技術メモ

これ以降はサイト管理者が当ページを管理するための技術メモです。よって、見なくても結構です。

抽出単語の区切り

抽出単語の最後の空白1文字を区切りに使う。改行、LF、CRは無視する。ただし空白は座標の再計算時に文字数に入れない。そうしないと文字数での計算でわずかに誤差が出てしまう。

空白が無い単語は次の単語と連結している扱いにする。

Acrobat JavaScriptの使用

当初はAcrobat OLEの GetText + GetRect を使っていたが、以下の理由でAcrobat JavaScriptの使用に変更した。

  1. 抽出されない文字(記号類)が有る
  2. 処理時間が掛かる
  3. ロジックがやや複雑になる

1は致命的で回避できなかった。調べるだけ時間の無駄!

更にAcrobat JavaScriptの方がAcrobat OLEのGetRectより、正確な座標が得られる。以下は座標 Top 数値の例。

  • Acrobat OLE の GetRect  :842
  • Acrobat JavaScript の quads:841.607421875

Acrobat JavaScriptでは小数点以下の値も得られる。小さい文字の場合、たった1ポイントの差がはみ出した位置になってしまう。

Acrobat JavaScriptメモ

type: "Highlight"「ハイライト」

座標にはquadsプロパティしか使えない。rectを使うと指定の座標には作成されない。メーカー公式マニュアル、更にネット情報を見るとすべてrectプロパティを使っているが、コピペして実行しても結果は不良となる。

type: "Square"「長方形の注釈」

座標指定にquadsプロパティは使えない。実行してもエラーにはならないが、注釈が作成されなかった。座標はrectプロパティを使う。

同一行の判断

テキストが同じ行(列)かの判断はTopとBottomの差が共に0.9より下の場合とする。

001 If Abs(iWkZahyo(i4, Zahyo.iTop) - _ 002 iWkZahyo(i4 + 1, Zahyo.iTop)) < 0.9 And _ 003 Abs(iWkZahyo(i4, Zahyo.iBottom) - _ 004 iWkZahyo(i4 + 1, Zahyo.iBottom)) < 0.9 Then 005 '次は同じ行

以上。

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