Acrobat, TOP, サンプル・関数

PDF上のテキストとその座標

コメントする

TOP > *      [...]

コスプレ

概要

PDF上のテキスト（文字列）と座標を扱う上で最低限必要な知識について、一部ですが解説します。

PDF上に存在するテキスト（文字列）をプログラミングで扱う上で必要な情報は３つです。

  1. 連続したテキスト
  2. その座標
  3. ページ番号

これが有れば、テキスト（文字列）をハイライト表示にして目立つようにしたり、取り消し線を入れたり、注釈を追加したり、様々な処理が可能になります。

　

テキストの区切り

PDF上のテキストは１文字では無く、「一定の単位」で分割されています。

例えば以下の場合

テキストを抽出する時の単位を青線で表示すると以下になります。

※↑↓クリックで拡大表示

青線はテキスト領域の座標を取得し、それを使ってVBA（Acrobat OLE＋Acrobat JavaScript）で描きました。

　

テキストの区切り

区切りの基本は以下です。

  1. 半角の英字：次の空白、改行、又は次の全角で区切り
  2. 半角の数字：次の空白、改行、又は次の全角で区切り
  3. 半角の記号：出現した後で区切り
  4. 全角文字：１文字単位で区切り

区切り、分割の条件を変更する設定等は存在しません。ただし、これは上記の画像の様な平坦な文章の場合です。

以下の書式が変化する文章では例外が発生します。

  1. 表紙、裏表紙
  2. 目次、索引、一覧表
  3. 絵や図中のテキスト
  4. 数式や計算式などの記号の塊

テキストと座標の関係が一致しなかったり、テキストの区切りも変化します。複数のテキスト（単語）が区切られないで連続した文字列として扱われる場合もあります。半角文字と全角文字が混ざった状態も存在します。

規則性みたいなモノを見つけて対応出来ないかと、かなり調査してみましたが見つけることは出来ませんでした。

　

　

抽出されたテキスト

上記「テキストの区切り」で紹介したPDFからテキストを抽出した時のサンプルです。

  • [Space(1)]：半角スペース１個
  • [CRLF]：改行コード

を意味します。

Seq テキスト
1 Windows[Space(1)]
2 10[Space(1)]
3 Home[Space(1)]
4 64
5 ビ
6 ッ
7 ト[CRLF]
8 CPU[Space(1)]
9 Core[Space(1)]
10 i5-
11 9400[CRLF]
12 イ
13 ン
14 テ
15 ル
16 Core[Space(1)]
17 i5-
18 9400[Space(1)]
19 (
20 2.90GHz-
21 4.10GHz/
22 6
23 コ
24 ア
25 /
26 6
27 ス
28 レ
29 ッ
30 ド
31 )[CRLF]

半角１文字の空白と改行コードが有ることで、単語の区切りや改行の判断に利用できます。空白だけというテキストは存在しません。

改行はCRLFコードだけでなく、LF（ラインフィールド）も有ります。規則性は判断できていません。CR（キャリッジリターン）だけによる改行は見当たりません。

PDFから取得するテキストは基本的に上記のイメージで来ると思って下さい。

ただし、状況により「例外」も存在します。

　

座標

Acrobat OLE経由で操作可能なAcrobat JavaScriptで扱える座標について説明をします。当サイトで必要と思われるものだけ紹介します。

１．Quads：テキストの座標

PDF上のテキストの座標はQuadsプロパティで表します。

Quadsプロパティは以下の １ｘ から ４ｙ までの８つの値を持ちます。各値はテキスト領域の四方座標の値になります。必ず８つの値を１組にしてテキストの座標を表します。

※稀に座標値が無いのも有りますが、その場合は不良として無視して結構です。

quadsプロパティ：単独の座標

PDFはページ左下を基点（0，0）とします。右横方向にX軸、上方向にｙ軸となります。

Quadsプロパティは２組以上の値を持つ場合も有ります。途中で改行した連続したテキストの座標はこれに当たります。それ以外でも使われることが有ります。

quadsプロパティ：複数の座標

２．Rect：四角形の座標

四角の注釈の座標を表します。４つの値（Left , Bottom , Right , Top）で四角形の位置を示します。

Quadsプロパティはイタリック文字のズレまで表現できますが、Rectプロパティは出来ません。

３．vertices：位置の座標

PDF上に線を描く時に使うプロパティです。[x , y] で１組の位置を示します。

vertices: [[50,650],[150,700],[200,550]] で以下の三角形を描けます。

上記を描いた時のAcrobat JavaScriptです。

//多角形 Acrobat JavaScript サンプル var annot = this.addAnnot({ page: 0, type: 'Polygon', vertices: [[50,650],[150,700],[200,550]], strokeColor:color.blue , width:0.1 , });

　

座標の取得はAcrobat JavaScript

「３つの情報」（テキスト、座標、ページ番号）を得る方法はAcrobat JavaScriptしか手がありません。

Acrobat OLEも機能は存在しますが、ある条件になると記号のテキストが抽出されない致命的な問題を確認しています。回避方法はありません。また処理時間の問題や、ロジックの組み方によっては座標が取得できない問題点も有ります。

　

「３つの情報」を取得するサンプル

ExecuteThisJavascriptを使って、Acrobat JavaScriptを実行します。その結果を受け取り、以下の処理を行います。

  1. 取得した座標で該当テキストに注釈の四角形の青線を追加
  2. 追加した注釈に座標のテキストを追加
  3. テキスト、座標、ページ番号の情報をテキストファイルへ出力
  4. 入力ファイルの後に「-Square」を追加して同じフォルダに別名で保存

サンプルは関数「OutSquareRectsLog」として作成しています。

  1. 第１引数：
    PDFファイルのフルパスを指定
  2. 第２引数：
    開始ページ番号、－１で先頭ページ指定
  3. 第３引数：
    終了ページ番号、－１で最終ページ指定
  4. 第４引数：
    Trueにすると座標情報のテキストファイルを出力
  5. 第５引数：
    Trueにすると注釈に座標の情報も一緒に表示
    以下の画像を参照

注意）処理時間が掛かるので、最初は３頁ほどでテストしてください。

ダウンロード：sample-OutSquareRectsLog.xls

ソースコードの178～204で座標情報の取得は完了しています。

001 Option Explicit 002 003 Private Enum JsZahyo 'JavaScriptから取得のQuads座標 004 iTop = 1 005 iBottom = 5 006 iLeft = 0 007 iRight = 2 008 End Enum 009 '※ 0[Left] 1[Top] 2[Right] 3[Top] 010 '※ 4[Left] 5[Bottom] 6[Right] 7[Bottom] 011 012 013 Sub Main_Test() 014 Dim bRet As Boolean 015 Dim sInFilePathIn As String 016 017 sInFilePathIn = ThisWorkbook.Path & "\test-002.pdf" 018 ' sInFilePathIn = ThisWorkbook.Path & "\手書きPDF入門-4.pdf" 019 Dim start As Double: start = Timer 020 021 bRet = OutSquareRectsLog(sInFilePathIn, -1, -1, False, True) 022 023 MsgBox "処理時間 = " & Timer - start 024 End Sub 025 026 027 '************************************************** 028 ' 029 ' 指定ページに四角の枠を付ける。 030 ' 座標の注釈も追加できる。 031 ' 032 ' Create : 2020/04/14 033 ' Update : 034 ' Vertion : 1.0.1 035 036 ' 引数１ : sInFilePathIn As String (IN) 037 ' 検索するPDFのフルパスdebu 038 ' 039 ' 引数２　：lInPageStart As Long (IN) 040 ' 検索の開始ページ 041 ' 先頭ページは１です 042 ' -1は最初から検索 043 ' 044 ' 引数３　：lInPageEnd As Long (IN) 045 ' 検索の終了ページ 046 ' -1で最終ページまで検索 047 ' 048 ' 引数４　：bOutLog As Boolean (IN) 049 ' True ：座標情報をテキストファイルへ出力 050 ' False：しない 051 ' 052 ' 引数５　：bContents As Boolean (IN) 053 ' True ：座標情報を注釈として追加 054 ' False：しない 055 ' 056 ' 戻り値 : True 正常処理 057 ' False エラー処理 PDFで無い 058 ' 059 ' URL : https://pdf-file.nnn2.com/?p=1099 060 ' 061 ' その他 : 著作権等は主張しません。 062 ' 上記URLにコメントを頂けると嬉しいです。 063 ' 064 '************************************************** 065 066 Public Function OutSquareRectsLog( _ 067 ByVal sInFilePathIn As String, _ 068 ByVal lInPageStart As Long, _ 069 ByVal lInPageEnd As Long, _ 070 ByVal bOutLog As Boolean, _ 071 ByVal bContents As Boolean) As Boolean 072 073 On Error GoTo Err_OutSquareRectsLog: 074 075 Dim start As Double: start = Timer 076 077 '初期値 078 OutSquareRectsLog = True 079 080 Dim i1 As Long 081 Dim i2 As Long 082 Dim iPageNo As Long 083 Dim iPageCnt As Long 084 Dim bRet As Boolean 085 Dim iPageStart As Long 086 Dim iPageEnd As Long 087 088 Dim sAJS As String 089 Dim sAJS_MG As String 090 Dim sReturn As String 091 Dim MG_Cnt As Long 092 Dim sWkCon As String 093 Dim sJsText As String 094 Dim sJsWk2() As String 095 Dim sJsWk3() As String 096 Dim sJsQuads() As String 097 098 Dim bCRLF As Boolean 099 Dim bCR As Boolean 100 Dim bLF As Boolean 101 Dim bSpace As Boolean 102 103 Const sAcrobatJavaScript = _ 104 "var sOut='';" & _ 105 "var numWords = this.getPageNumWords(@P);" & _ 106 "for ( var j = 0; j < numWords; j++) {" & _ 107 " nthWord = this.getPageNthWord(@P,j,false);" & _ 108 " aQuads = this.getPageNthWordQuads(@P,j);" & _ 109 " sOut=sOut + j + '\b' + nthWord + " & _ 110 "'\b' + aQuads + '\t';" & _ 111 "}" & _ 112 "event.value=sOut;" 113 114 '※上記の特殊文字はデータの区切りに使用 115 '　（\b：バックスペース）（\t：タブ） 116 117 Const sAcrobatJavaScript2 = _ 118 "oRet = this.addAnnot({" & _ 119 " type: 'Square' ," & _ 120 " rect:[@1,@2,@3,@4] ," & _ 121 " page:@p ," & _ 122 " strokeColor:color.blue ," & _ 123 " width:0.3 ," & _ 124 " @t " & _ 125 "}); " 126 127 ' " contents:'@t'," & _ 128 129 If Dir$(sInFilePathIn, vbNormal) = "" Then 130 MsgBox sInFilePathIn & vbCrLf & _ 131 "ファイルが存在しない。", _ 132 vbOKOnly + vbCritical, "実行エラー" 133 OutSquareRectsLog = False 134 Exit Function 135 End If 136 137 'Acrobatオブジェクトの定義＆作成 138 '※ここのオブジェクトをグローバル変数にしては駄目！ 139 '　Acrobat 7,8,9,10,11 の時 140 Dim objAcroApp As New Acrobat.AcroApp 141 Dim objAcroAVDoc As New Acrobat.AcroAVDoc 142 Dim objAcroPDDoc As New Acrobat.AcroPDDoc 143 Dim objAcroPDPage As Acrobat.AcroPDPage 144 Dim objAcroAVPageView As Acrobat.AcroAVPageView 145 Dim objAFormApp As AFORMAUTLib.AFormApp 146 Dim objAFormFields As AFORMAUTLib.Fields 147 Dim objAFormField As AFORMAUTLib.Field 148 149 If bOutLog Then Call Log_Start 150 151 objAcroApp.CloseAllDocs 152 objAcroApp.Hide '稀にデスクトップに表示されるので隠す 153 154 'PDFファイルを開く 155 If objAcroAVDoc.Open(sInFilePathIn, "") = False Then 156 MsgBox "Open出来ません。" & vbCrLf & sInFilePathIn, _ 157 vbOKOnly + vbCritical, "実行エラー" 158 OutSquareRectsLog = False 159 GoTo Skip_OutSquareRectsLog_END: 160 End If 161 162 Application.Cursor = xlWait 'マウスポインターを砂時計 163 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc 164 iPageStart = IIf(lInPageStart = -1, 0, lInPageStart - 1) 165 iPageEnd = IIf(lInPageEnd = -1, objAcroPDDoc.GetNumPages, lInPageEnd) - 1 166 167 Set objAFormApp = CreateObject("AFormAut.App") 168 Set objAFormFields = objAFormApp.Fields 169 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc 170 171 sAJS_MG = "" 172 MG_Cnt = 0 173 For iPageNo = iPageStart To iPageEnd 174 175 '▼頁単位で全文字列＋座標を抽出 176 177 'Acrobat JavaScriptの編集 178 sAJS = sAcrobatJavaScript 179 sAJS = Replace(sAJS, "@P", iPageNo) 180 'Acrobat JavaScript の実行 181 sReturn = objAFormFields.ExecuteThisJavascript(sAJS) 182 183 sJsWk2 = Split(sReturn, vbTab) 184 185 Debug.Print "Page=" & iPageNo + 1 & _ 186 " Start-Time=" & Time & " Count=" & UBound(sJsWk2) + 1 187 188 For i1 = 0 To UBound(sJsWk2) 189 If sJsWk2(i1) = "" Then Exit For 190 sJsWk3 = Split(sJsWk2(i1), vbBack) 191 192 'テキスト 193 sJsText = sJsWk3(1) 194 If bOutLog Then 195 bSpace = (InStr(sJsText, " ") > 0) 196 bCRLF = (InStr(sJsText, vbCrLf) > 0) 197 bCR = (InStr(sJsText, vbCr) > 0) 198 bLF = (InStr(sJsText, vbLf) > 0) 199 End If 200 sJsText = Replace(sJsText, vbLf, "") 201 sJsText = Replace(sJsText, vbCr, "") 202 203 '座標 204 sJsQuads = Split(sJsWk3(2), ",") 205 sJsText = Replace(sJsText, "'", "''") 206 sAJS = sAcrobatJavaScript2 207 sAJS = Replace(sAJS, "@1", sJsQuads(JsZahyo.iLeft)) 208 sAJS = Replace(sAJS, "@2", sJsQuads(JsZahyo.iBottom)) 209 sAJS = Replace(sAJS, "@3", sJsQuads(JsZahyo.iRight)) 210 sAJS = Replace(sAJS, "@4", sJsQuads(JsZahyo.iTop)) 211 sAJS = Replace(sAJS, "@p", iPageNo) 212 If bContents Then 213 sWkCon = "Text=[" & sJsText & "] " & _ 214 " WNo=" & i1 & _ 215 " Top=" & sJsQuads(JsZahyo.iTop) & _ 216 " Bottom=" & sJsQuads(JsZahyo.iBottom) & _ 217 " Left=" & sJsQuads(JsZahyo.iLeft) & _ 218 " Right=" & sJsQuads(JsZahyo.iRight) 219 sAJS = Replace(sAJS, "@t", _ 220 " contents:'" & sWkCon & "', ") 221 Else 222 sAJS = Replace(sAJS, "@t", "") 223 End If 224 225 '■Acrobat JavaScript の実行 226 sAJS_MG = sAJS_MG & sAJS 227 MG_Cnt = MG_Cnt + 1 228 If MG_Cnt >= 100 Then 229 '※処理時間の短縮の為 230 sReturn = objAFormFields.ExecuteThisJavascript(sAJS_MG) 231 Debug.Print "Page=" & iPageNo + 1 & " i1=" & i1 & _ 232 " Time=" & Time 233 sAJS_MG = "": MG_Cnt = 0 234 End If 235 DoEvents 236 237 'テキストファイルの出力 238 If bOutLog Then 239 Call Put_Degug_log( _ 240 "Page=" & iPageNo & " " & _ 241 " [" & sJsWk3(0) & "] (" & _ 242 sJsText & ") " & _ 243 IIf(bSpace, "-Space", "") & _ 244 IIf(bCRLF, "-CRLF", "") & _ 245 IIf(bCR, "-CR", "") & _ 246 IIf(bLF, "-LF", "") & _ 247 " Top[" & sJsQuads(JsZahyo.iTop) & _ 248 "] Bottom[" & sJsQuads(JsZahyo.iBottom) & _ 249 "] Left[" & sJsQuads(JsZahyo.iLeft) & _ 250 "] Right[" & sJsQuads(JsZahyo.iRight) & "]") 251 End If 252 Next i1 253 254 Next iPageNo 255 256 '■Acrobat JavaScript の実行 257 If sAJS_MG <> "" Then 258 '※処理時間の短縮の為 259 sReturn = objAFormFields.ExecuteThisJavascript(sAJS_MG) 260 Debug.Print "Page=" & iPageNo + 1 & " i1=" & i1 & _ 261 " Time=" & Time 262 End If 263 264 'PDFファイルを別名で保存 265 Dim sFilePathOut As String 266 sFilePathOut = Replace(sInFilePathIn, ".pdf", "-Square.pdf") 267 If objAcroPDDoc.Save(1, sFilePathOut) = False Then 268 MsgBox "PDFファイルへ保存出来ませんでした", _ 269 vbOKOnly + vbCritical, "実行エラー" 270 End If 271 272 Application.Cursor = xlDefault 'マウスポインターを戻す 273 'PDFファイルを閉じる 274 If objAcroAVDoc.Close(False) = False Then 275 MsgBox "AVDocオブジェクトはClose出来ませんでした", _ 276 vbOKOnly + vbCritical, "実行エラー" 277 OutSquareRectsLog = False 278 End If 279 280 Skip_OutSquareRectsLog_END: 281 282 On Error Resume Next 'これ以降は強制実行 283 284 Application.Cursor = xlDefault 'マウスポインターを戻す 285 '変更しないで閉じます。 286 bRet = objAcroAVDoc.Close(False) 287 'Acrobatアプリケーションの終了 288 objAcroApp.Hide 289 objAcroApp.Exit 290 'オブジェクトの開放 291 Set objAFormFields = Nothing 292 Set objAFormField = Nothing 293 Set objAFormApp = Nothing 294 Set objAcroAVPageView = Nothing 295 Set objAcroPDPage = Nothing 296 Set objAcroPDDoc = Nothing 297 Set objAcroAVDoc = Nothing 298 Set objAcroApp = Nothing 299 300 If bOutLog Then Call Run_NOTEPAD 301 302 Debug.Print "Total Time = " & Timer - start & _ 303 " PageCnt = " & iPageEnd - iPageStart + 1 304 305 Exit Function 306 307 Err_OutSquareRectsLog: 308 MsgBox "処理は以下の理由で中断しました。" & vbCrLf & _ 309 vbCrLf & Err.Number & vbCrLf & Err.Description, _ 310 vbOKOnly + vbCritical, "実行エラー" 311 OutSquareRectsLog = False 312 GoTo Skip_OutSquareRectsLog_END: 313 End Function


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

上記サンプルをベースにした関数「文字列のページ番号と座標を返す」も公開しています。テキストを指定するとその座標とページ番号を返します。

　

ページ内の全テキスト領域の座標

この情報が必要になる事が存在するとは思いませんが、公開します。

以下を見てください。ページの上部にテキストが集中して表示されています。その青線で囲った領域の座標を言います。

それを取得するサンプルです。Debug.Print でページ単位に表示しています。ダウンロード公開はしてないので、以下のVBAソースをコピペしてご利用ください。Acrobat OLEのみで処理しています。

001 Option Explicit 002 003 Sub Main_Patern_3() 004 Dim i1 As Long 005 Dim iPageNo As Long 006 Dim iPageCnt As Long 007 Dim iRet As Long 008 Dim bRet As Boolean 009 010 Dim objAcroApp As New Acrobat.AcroApp 011 Dim objAcroAVDoc As New Acrobat.AcroAVDoc 012 Dim objAcroPDDoc As New Acrobat.AcroPDDoc 013 Dim objAcroPDPage As Acrobat.AcroPDPage 014 Dim objAcroHiliteList As New Acrobat.AcroHiliteList 015 Dim objAcroPDTextSelect As Acrobat.AcroPDTextSelect 016 Dim objAcroRect As Acrobat.AcroRect 017 018 Dim sFilePathIn As String 019 sFilePathIn = ThisWorkbook.Path & "\test-001.pdf" 020 objAcroApp.CloseAllDocs 021 objAcroApp.Hide '稀にデスクトップに表示されるので隠す 022 'PDFファイルを開く 023 bRet = objAcroAVDoc.Open(sFilePathIn, "") 024 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc 025 iPageCnt = objAcroPDDoc.GetNumPages 026 027 For iPageNo = 0 To iPageCnt - 1 028 'ページ単位のPDPageオブジェクトを作成 029 Set objAcroPDPage = objAcroPDDoc.AcquirePage(iPageNo) 030 'ハイライトリストを作成 031 Set objAcroHiliteList = Nothing '先にクリア 032 iRet = objAcroHiliteList.Add(0, 32767) 033 If objAcroHiliteList Is Nothing Then 034 'ページにテキストが無い 035 Exit For 036 End If 037 'テキスト選択のPDTextSelectオブジェクトを作成 038 Set objAcroPDTextSelect = _ 039 objAcroPDPage.CreateWordHilite(objAcroHiliteList) 040 If objAcroPDTextSelect Is Nothing Then _ 041 GoTo Main_Patern_3_skip1: 042 043 '四方範囲(AcroRect)を取得 044 Set objAcroRect = _ 045 objAcroPDTextSelect.GetBoundingRect 046 With objAcroRect 047 Debug.Print "PageNo=" & iPageNo + 1 & _ 048 " Top=" & .Top & _ 049 " Bottom=" & .bottom & _ 050 " Left=" & .Left & _ 051 " Right=" & .Right 052 End With 053 054 Main_Patern_3_skip1: 055 Next iPageNo 056 057 '変更しないで閉じます。 058 bRet = objAcroAVDoc.Close(False) 059 'Acrobatアプリケーションの終了 060 objAcroApp.Hide 061 objAcroApp.Exit 062 'オブジェクトの開放 063 Set objAcroRect = Nothing 064 Set objAcroHiliteList = Nothing 065 Set objAcroPDTextSelect = Nothing 066 Set objAcroPDPage = Nothing 067 Set objAcroPDDoc = Nothing 068 Set objAcroAVDoc = Nothing 069 Set objAcroApp = Nothing 070 End Sub


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

当然ですがヘッダーやフッターが存在すると領域はドンと広がります。

　

参照

　

　

管理者の技術メモ

これ以降は当ページをサイト管理者が管理するための情報です。見る必要は無いです。公開用にも書いてません。

　

イタリック文字

Quads値の1yと2yのズレで判断できると思ったが、ズレてないPDFも有る。PDF上のイタリック表示とQuads値は一対一では無い。

「PDF上のテキストの位置とQuads値は必ずしも一対一では無い」と言う判断は間違い？

　

座標の値が重なる

一部のテキストの座標を四角形の注釈で表示。「。」の後と「Acrobat」の前の部分が重なっている。

テキストの座標の値が重なった例 - 「。」の右端と「Acrobat」の左端が重なる

この様なケースもかなり沢山有ある。例えば、３ページのPDFで2484件の座標情報を持ったテキストが存在する。

  • A) 141件：前のテキストの右端 = 次のテキストの左端
  • B) 105件：前のテキストの右端 > 次のテキストの左端
    • 約 90％：0.1以下のサイズオーバー
    • 約 10％：1.0 以上のサイズオーバー

Aのケースは座標を扱う上で問題は出てない（今の所）。しかしBのケースでは座標の数値判断で支障が出る。この場合は強制的に値の補正をして処理する必要が有る。

補正の仕方は。「。」の右端がはみ出しているので、「Acrobat」の左端の座標の値を強制的に「。」の右端に適用する。今の所は、このやり方で正常に処理が出来ている。

補正のサンプルとして、「関数：座標上のテキストを取得」（準備中）又は「関数：文字列のページ番号と座標を返す」を御覧ください。 当初と処理方法が変わったので今はロジックは入ってない。

　

座標のサンプル

QuadsとRectの実際の値。以下の図の「Windows」の例。

quads : [ [ 91.58000183105469 , 621.9847412109375 , 119.71980285644531 , 621.9847412109375 , 91.58000183105469 , 614.0368041992188 , 119.71980285644531 , 614.0368041992188 ] ]

rect: [785.3150634765625 , 777.3671264648438 , 56.58000183105469 , 84.72042846679688」

と小数点以下まで有る。Acrobat OLEでは小数点以下は四捨五入。

２文字以上のテキスト内の文字の座標が欲しいときは、文字数で計算する必要が有る。例外的な座標の場合はこのやり方は逆に弊害になるが。

　

Acrobat OLEの使用はNG

永～～い検証期間の結果、Acrobat OLEでのテキストと座標の取得はNGと決定。回避できない 致命的な問題 が存在する為。詳細は後で。

　

同じ行のテキストでも異なる高さの座標

１つの行に並んだテキストでも高さ（Top、Bottom）の座標が異なる場合が有る。

同じ行でも高さ（Top , Bottom）の座標が異なるケース

各テキストの高さの座標は　※小数点以下は省略

  • 「jso」　　 　　　　　：Top=542 , Bottom=532
  • 「は」　　　　　　　　：Top=544 , Bottom=531
  • 「(Doc」　　　　　　　：Top=542 , Bottom=532
  • 「オブジェクトである」：Top=544 , Bottom=531

この様なケースは結構有る。

なお、VBAから見ると、

If (左のTop = 右のTop ) And (左のBottom = 右のBottom ) Then

での判断は駄目。上付き、下付き、サイズ変更も考慮すると、

If　( (左のLeft < 右のLeft) And (左のRight < 右のRight)　) And
(　(左のTop = 右のTop ) And (左のBottom = 右のBottom ) Or
(左のTop > 右のTop ) And (左のBottom < 右のBottom ) Or
(左のTop < 右のTop ) And (左のBottom > 右のBottom )　) Then

で同じ行だとの判断になる。

但し、公開しているサンプルに当ロジックは入ってない。処理方法が当初と変わったから。

　

同じ行のテキストでも異なる高さの座標（Part2）

１つの行に並んだテキストでも高さ（Top、Bottom）の座標が異なる場合が有る。

同じ行でも高さ（Top , Bottom）の座標が異なるケース

検証する。以下を実行。

oRet = this.addAnnot({
　type:　'Highlight' ,
　quads:　[[319,644,456,644,397,631,456,631]],
　page:　999 ,
　strokeColor:　color.yellow ,
　width:　0.3 ,
});

実行結果は以下。

ここまでをまとめると

  1. 元のテキストは高さ（Top、Bottom）が異なる座標。
    ※Acrobatで見るとフォントが異なります。フォントによって座標上の高さも変わると言う事でしょう。（タブン
  2. 手作業でハイライト表示にするとテキストの座標と同じ様に高さが異なるハイライト表示になる。
  3. Acrobat JavaScriptでは同じ高さのハイライト表示が出来る。可能だ。

高さの異なるハイライト表示になるかは手作業でしたか、しないかによって変わる。

　

同じ行のテキストでも異なる高さの座標（Part3）

フォントサイズオーバー、上付き、下付きのテキストを強制的に手作業で作ってみた。

「AAA」、「BB」、「CC」のテキスト座標の一部を見ると以下のように規則性が見える。

[0] (Windows ) -Space Top[818] Bottom[810] Left[42] Right[70] [1] (10 ) -Space Top[818] Bottom[810] Left[74] Right[82] [2] (Home ) -Space Top[818] Bottom[810] Left[86] Right[102] [3] (64) Top[818] Bottom[810] Left[106] Right[114] [4] (AA) Top[830] Bottom[808] Left[114] Right[147] [5] (ビ) Top[818] Bottom[810] Left[147] Right[155] [6] (BB) Top[818] Bottom[810] Left[155] Right[163] [7] (ッ) Top[818] Bottom[810] Left[163] Right[171] [8] (ト) Top[818] Bottom[810] Left[171] Right[179] [9] (CC) -CRLF-CR-LF Top[821] Bottom[805] Left[179] Right[195] [10] (DD ) -Space-LF Top[831] Bottom[815] Left[195] Right[211

ただし「DD」は規則性を逸脱している。何度も上付き下付きの操作を繰り返した結果かもしれない。「DD」のパターンは無視。無視しても大きく影響が出る箇所は無いと予想。（実際、やってみないと分からない。

　

Quads値を数値で扱う問題点

座標を示すQuadsを数値で扱うと小数点以下１２桁目以降が四捨五入等で丸められてしまう。正確性が必要な時は文字列で扱ったほうがイイ。しかし数値比較の時にVal関数で数値変換など、タダでさえ複雑なロジックが見栄えで増えてしまう。

現実的には座標の小数点２桁目以下は無視しても問題ないレベルだが。プログラムでの処理上、やはり多少は考慮が必要になる。

Quads値は数値処理が必要無い所では文字列として扱うを基本とする。

　

座標は昇順でない

行単位で左から右へと並んでいるかの話。偶然？だが、複数の連続するテキストがハイライトになっていた場合、そのハイライト表示の座標が高さ（Top、Bottom）単位で並べ替えられていたのを発見！。並びがテキストと同じでなくてもハイライトの座標が全体で完結しているので問題は無い。と言うのは嘘で。座標からハイライトになっているテキストを抽出す時に困る。その時は座標を並び替えることにした。

PDF上に表示されているテキストに関しては行単位で左から右へ並んでいる。並んでないのは（今の所は）見つかってない。

　

抽出パターンの特徴

Acrobat OLEでのテキスト抽出は２パターン存在。２つとも　AcroHiliteList.Add で抽出をする。※あくまでもメモ情報。

  1. パターン①
    iRet = objAcroHiliteList.Add( 0 , 32767 )
    一括で抽出を開始するパターン
    • 特徴：
      • ページ全体のテキスト抽出が高速で出来る
      • テキストの最後の半角空白や改行コードでテキスト（単語）の区切りが判断可能
    • 問題点：
      • テキスト（単語単位）の座標は取得できない
        ページ全体のテキスト領域の座標しか取得できない
  2. パターン②
    iRet = objAcroHiliteList.Add( x , 1 )
    １単語単位に処理するパターン
    • 特徴：
      • テキストとその座標が取得できる
    • 問題点：
      • 抽出されないテキストが存在　＜－致命的！
        回避方法は見つからなかった
      • テキストの区切り、改行が無いので困る！
        座標を見たら判断可能かもしれないがかなり微妙！
      • テキスト別の座標の取得には処理時間が掛かる

　

上記のVBAサンプル

上記の検証で使ったサンプル。

テキスト抽出はAcroPDTextSelectオブジェクトのGetTextメソッドで行います。ただし、途中のオブジェクト操作によってGetTextメソッドの結果が前述のパターン①、パターン②に変わります。

CreatePageHilite での文字列抽出は不可解な結果が出る場合が有るので使用は推奨しない。CreateWordHilite のみを使う前提で解説。

ダウンロード：Sample-Get-Text-Rect.xls　※公開終了

パターン①：

001 Option Explicit 002 003 Sub Main_Patern_1() 004 005 Dim i1 As Long 006 Dim i2 As Long 007 Dim j As Long 008 Dim iCnt As Long 009 Dim iPageNo As Long 010 Dim iPageCnt As Long 011 Dim iRet As Long 012 Dim bRet As Boolean 013 Dim sGetText(1000) As String 014 015 Dim objAcroApp As New Acrobat.AcroApp 016 Dim objAcroAVDoc As New Acrobat.AcroAVDoc 017 Dim objAcroPDDoc As New Acrobat.AcroPDDoc 018 Dim objAcroPDPage As Acrobat.AcroPDPage 019 Dim objAcroHiliteList As New Acrobat.AcroHiliteList 020 Dim objAcroPDTextSelect As Acrobat.AcroPDTextSelect 021 022 Dim sFilePathIn As String 023 sFilePathIn = ThisWorkbook.Path & "\test-001.pdf" 024 objAcroApp.CloseAllDocs 025 objAcroApp.Hide '稀にデスクトップに表示されるので隠す 026 'PDFファイルを開く 027 bRet = objAcroAVDoc.Open(sFilePathIn, "") 028 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc 029 iPageCnt = objAcroPDDoc.GetNumPages 030 031 i2 = 0 032 For iPageNo = 0 To iPageCnt - 1 033 'ページ単位のPDPageオブジェクトを作成 034 Set objAcroPDPage = objAcroPDDoc.AcquirePage(iPageNo) 035 'ハイライトリストを作成 036 Set objAcroHiliteList = Nothing '先にクリア 037 iRet = objAcroHiliteList.Add(0, 32767) 038 If objAcroHiliteList Is Nothing Then 039 'ページにテキストが無い 040 Exit For 041 End If 042 'テキスト選択のPDTextSelectオブジェクトを作成 043 Set objAcroPDTextSelect = _ 044 objAcroPDPage.CreateWordHilite(objAcroHiliteList) 045 If objAcroPDTextSelect Is Nothing Then _ 046 GoTo Main_Patern_1_skip1: 047 '抽出した文字列の数(Index)を取得 048 iCnt = objAcroPDTextSelect.GetNumText() - 1 049 For j = 0 To iCnt 050 sGetText(i2) = objAcroPDTextSelect.GetText(j) 051 ' sGetText(i2) = Replace(sGetText(i2), " ", "[Space(1)]") 052 ' sGetText(i2) = Replace(sGetText(i2), vbCrLf, "[CRLF]") 053 i2 = i2 + 1 054 Next j 055 Main_Patern_1_skip1: 056 Next iPageNo 057 058 '★ 059 '★sGetText(i2)：抽出した全テキスト 060 '★ 061 Debug.Print "Get件数=" & i2 062 063 '変更しないで閉じます。 064 bRet = objAcroAVDoc.Close(False) 065 'Acrobatアプリケーションの終了 066 objAcroApp.Hide 067 objAcroApp.Exit 068 'オブジェクトの開放 069 Set objAcroHiliteList = Nothing 070 Set objAcroPDTextSelect = Nothing 071 Set objAcroPDPage = Nothing 072 Set objAcroPDDoc = Nothing 073 Set objAcroAVDoc = Nothing 074 Set objAcroApp = Nothing 075 076 End Sub


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

パターン②：

001 Option Explicit 002 003 Sub Main_Patern_2() 004 005 Dim i1 As Long 006 Dim i2 As Long 007 Dim iCnt As Long 008 Dim iPageNo As Long 009 Dim iPageCnt As Long 010 Dim iRet As Long 011 Dim bRet As Boolean 012 Dim sGetText(1000) As String 013 Dim sGetTextXY(1000, 3) As Long 014 015 Dim objAcroApp As New Acrobat.AcroApp 016 Dim objAcroAVDoc As New Acrobat.AcroAVDoc 017 Dim objAcroPDDoc As New Acrobat.AcroPDDoc 018 Dim objAcroPDPage As Acrobat.AcroPDPage 019 Dim objAcroPoint As Acrobat.AcroPoint 020 Dim objAcroHiliteList As New Acrobat.AcroHiliteList 021 Dim objAcroAVPageView As Acrobat.AcroAVPageView 022 Dim objAcroPDTextSelect As Acrobat.AcroPDTextSelect 023 Dim objAcroRect As Acrobat.AcroRect 024 025 Dim sFilePathIn As String 026 sFilePathIn = ThisWorkbook.Path & "\test-001.pdf" 027 objAcroApp.CloseAllDocs 028 objAcroApp.Hide '稀にデスクトップに表示されるので隠す 029 'PDFファイルを開く 030 bRet = objAcroAVDoc.Open(sFilePathIn, "") 031 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc 032 iPageCnt = objAcroPDDoc.GetNumPages 033 034 i2 = 0 035 For iPageNo = 0 To iPageCnt - 1 036 'ページ単位のPDPageオブジェクトを作成 037 Set objAcroPDPage = objAcroPDDoc.AcquirePage(iPageNo) 038 For i1 = 0 To 9999 039 'ハイライトリストを作成 040 Set objAcroHiliteList = Nothing '先にクリア 041 iRet = objAcroHiliteList.Add(i1, 1) 042 If objAcroHiliteList Is Nothing Then 043 'ページにテキストが無い 044 Exit For 045 End If 046 'テキスト選択のPDTextSelectオブジェクトを作成 047 Set objAcroPDTextSelect = _ 048 objAcroPDPage.CreateWordHilite(objAcroHiliteList) 049 If objAcroPDTextSelect Is Nothing Then _ 050 GoTo Main_Patern_2_skip1: 051 '抽出した文字列の数(Index)を取得：0が返される 052 iCnt = objAcroPDTextSelect.GetNumText() - 1 053 sGetText(i2) = objAcroPDTextSelect.GetText(0) 054 ' sGetText(i2) = Replace(sGetText(i2), " ", "[Space(1)]") 055 ' sGetText(i2) = Replace(sGetText(i2), vbCrLf, "[CRLF]") 056 '四方範囲(AcroRect)を取得 057 Set objAcroRect = _ 058 objAcroPDTextSelect.GetBoundingRect 059 With objAcroRect 060 sGetTextXY(i2, 0) = .Top 061 sGetTextXY(i2, 1) = .bottom 062 sGetTextXY(i2, 2) = .Left 063 sGetTextXY(i2, 3) = .Right 064 End With 065 ' Debug.Print i2 + 1 & "=[" & sGetText(i2) & _ 066 ' "] Top=" & sGetTextXY(i2, 0) & _ 067 ' " Bottom=" & sGetTextXY(i2, 1) & _ 068 ' " Left=" & sGetTextXY(i2, 2) & _ 069 ' " Right=" & sGetTextXY(i2, 3) 070 i2 = i2 + 1 071 Next i1 072 Main_Patern_2_skip1: 073 Next iPageNo 074 075 '★ 076 '★sGetText(i2)　　 ：抽出したテキスト 077 '★sGetTextXY(i2, 3)：テキストに対応した座標 078 Debug.Print "Get件数=" & i2 079 080 '変更しないで閉じます。 081 bRet = objAcroAVDoc.Close(False) 082 'Acrobatアプリケーションの終了 083 objAcroApp.Hide 084 objAcroApp.Exit 085 'オブジェクトの開放 086 Set objAcroHiliteList = Nothing 087 Set objAcroAVPageView = Nothing 088 Set objAcroPDTextSelect = Nothing 089 Set objAcroRect = Nothing 090 Set objAcroPDPage = Nothing 091 Set objAcroPoint = Nothing 092 Set objAcroPDDoc = Nothing 093 Set objAcroAVDoc = Nothing 094 Set objAcroApp = Nothing 095 End Sub


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

テキスト（単語）と座標をテキストファイルへ出力

テキストの座標関連のロジックを検証するのには、詳細なテキストとその座標の情報が必要。それを作成するサンプルです。テキストファイルへ出力します。

sample-OutputTextRect-030.xlsm

ダウンロードでは公開していません。ソースをコピペして使います。

001 Option Explicit 002 003 ' ハイライトテキストの最大数 004 Private Const MAX_GetText As Long = 32767 005 006 Private Enum JZ 'JavaScriptから取得のQuads座標 007 iTop = 1 008 iTop2 = 3 009 iBottom = 5 010 iBottom2 = 7 011 iLeft = 0 012 iLeft2 = 4 013 iRight = 2 014 iRight2 = 6 015 End Enum 016 Private Enum JZ2 'JavaScriptから取得のQuads座標 017 i1x = 0 018 i1y = 1 019 i2x = 2 020 i2y = 3 021 i3x = 4 022 i3y = 5 023 i4x = 6 024 i4y = 7 025 End Enum 026 '※ 0[Left] 1[Top] 2[Right] 3[Top] 027 '※ 4[Left] 5[Bottom] 6[Right] 7[Bottom] 028 029 Private Type jsdata 030 iLineNo As Long '行番号 031 sText As String 'テキスト 032 sQuads As String 'Quads値 [1x,1y,2x,2y, 4x,4y]・・ 033 iQuadsCnt As Long 'Quads数 034 ' iQuadsCnt As Long 'Quads値の数 035 iQuadsNo As Long 'Quads値の連番 0:連番無し 1以上:連番有り 036 iType As Long 'Quads値のタイプ（テキストのタイプ） 037 sQuadsT1n(7) As String 'Quads値の元の値 038 sQuadsT2e(7) As String 'Quads値の並び替えた値 039 sStatus As String '状態 040 bSpace As Boolean 041 bCRLF As Boolean 042 bCR As Boolean 043 bLF As Boolean 044 End Type 045 046 Private SYORI_MODE As Long 047 Private Enum sM 048 Quads値の展開無 049 Quads値の展開有 050 End Enum 051 052 Private PRINT_MODE As Long 053 Private Enum PM 054 全て 055 通常以外 056 その他のみ 057 End Enum 058 059 Private Enum OutType 060 iPageCnt 'ページ数 061 iNormal '通常 062 i7Over 'Quads7オーバー 063 iItalic 'イタリック 064 iLeft90R '左90度回転 065 iRight90R '右90度回転 066 i180R '180度回転 067 iLeftR '左向き(1-89)回転 068 iRightR '右向き(1-89)回転 069 iLeftR_2 '左向き(91-179)回転 070 iRightR_2 '右向き(91-179)回転 071 iP90Left 'ページ左90度回転 072 iP90Right 'ページ右90度回転 073 iP180 'ページ180度回転 074 iEtc 'その他 075 IError 'エラー 076 iMach '座標一致 077 iOver '座標オーバー 078 iQuadsMax 'Quads数の最大値 079 iTypeChange 'Type違い 080 End Enum 081 082 Public Enum zType 083 iNormal = 0 '通常 084 iItalic = 1 'イタリック 085 iLeft90R = 2 '左90度回転 086 iRight90R = 3 '右90度回転 087 i180R = 4 '１８０度回転 088 iLeft = 5 '左向き(1-89)回転 089 iRight = 6 '右向き(1-89)回転 090 iLeft_2 = 7 '左向き(91-179)回転 091 iRight_2 = 8 '右向き(91-179)回転 092 iEtc = 9 '以外のタイプ 093 End Enum 094 095 '************************************************** 096 ' 097 ' 098 '************************************************** 099 100 Sub Main_XXXX() 101 102 Dim sFilePathIn As String 103 Dim i1 As Long 104 Dim iOutD(19) As Long 105 Dim sOut As String 106 107 With Worksheets("Sheet1") 108 109 SYORI_MODE = sM.Quads値の展開有 110 ' SYORI_MODE = sM.Quads値の展開無 111 PRINT_MODE = PM.全て 112 ' PRINT_MODE = PM.通常以外 113 ' PRINT_MODE = PM.その他のみ 114 115 For i1 = 56 To 56 'Max:571 116 117 sFilePathIn = Trim(.Range("C" & i1).Value) 118 If sFilePathIn = "" Then Exit For 119 If Trim(.Range("B" & i1).Value) <> "" Or _ 120 InStr(LCase(sFilePathIn), "test") > 0 Or _ 121 InStr(sFilePathIn, "セキュリティ付き") > 0 Then GoTo skip9: 122 123 Call Log_Start(sFilePathIn) 124 sFilePathIn = ThisWorkbook.Path & "\DATA\" & sFilePathIn 125 126 Call Put_Degug_log("【" & i1 & "】 " & sFilePathIn & " " & Time) 127 Call OutGetTextRects(sFilePathIn, iOutD) 128 129 .Range("E" & i1).Value = Time 130 .Range("F" & i1).Value = iOutD(OutType.iPageCnt) 131 .Range("H" & i1).Value = iOutD(OutType.i7Over) 132 133 sOut = "ページ数 = " & iOutD(OutType.iPageCnt) & vbCrLf & _ 134 "7Over = " & iOutD(OutType.i7Over) & vbCrLf 135 DoEvents 136 If SYORI_MODE = sM.Quads値の展開有 Then 137 .Range("G" & i1).Value = iOutD(OutType.iNormal) 138 .Range("I" & i1).Value = iOutD(OutType.iItalic) 139 .Range("J" & i1).Value = iOutD(OutType.iLeft90R) 140 .Range("K" & i1).Value = iOutD(OutType.iRight90R) 141 .Range("L" & i1).Value = iOutD(OutType.i180R) 142 .Range("M" & i1).Value = iOutD(OutType.iLeftR) 143 .Range("N" & i1).Value = iOutD(OutType.iRightR) 144 .Range("O" & i1).Value = iOutD(OutType.iLeftR_2) 145 .Range("P" & i1).Value = iOutD(OutType.iRightR_2) 146 .Range("T" & i1).Value = iOutD(OutType.iEtc) 147 .Range("W" & i1).Value = iOutD(OutType.iOver) 148 .Range("V" & i1).Value = iOutD(OutType.iMach) 149 .Range("Y" & i1).Value = iOutD(OutType.iTypeChange) 150 DoEvents 151 End If 152 sOut = sOut & _ 153 "通常 = " & iOutD(OutType.iNormal) & vbCrLf & _ 154 "イタリック = " & iOutD(OutType.iItalic) & vbCrLf & _ 155 "左90度回転 = " & iOutD(OutType.iLeft90R) & vbCrLf & _ 156 "右90度回転 = " & iOutD(OutType.iRight90R) & vbCrLf & _ 157 "180回転 = " & iOutD(OutType.i180R) & vbCrLf & _ 158 "左向き(1-89) = " & iOutD(OutType.iLeftR) & vbCrLf & _ 159 "右向き(1-89) = " & iOutD(OutType.iRightR) & vbCrLf & _ 160 "左向き(91-179)= " & iOutD(OutType.iLeftR_2) & vbCrLf & _ 161 "右向き(91-179)= " & iOutD(OutType.iRightR_2) & vbCrLf & _ 162 "その他 　 = " & iOutD(OutType.iEtc) & vbCrLf & _ 163 "Type違い = " & iOutD(OutType.iTypeChange) & vbCrLf & _ 164 "Mach = " & iOutD(OutType.iMach) & vbCrLf & _ 165 "Over = " & iOutD(OutType.iOver) & vbCrLf 166 167 .Range("Q" & i1).Value = iOutD(OutType.iP90Left) 168 .Range("R" & i1).Value = iOutD(OutType.iP90Right) 169 .Range("S" & i1).Value = iOutD(OutType.iP180) 170 .Range("U" & i1).Value = iOutD(OutType.IError) 171 .Range("X" & i1).Value = iOutD(OutType.iQuadsMax) 172 DoEvents 173 sOut = sOut & _ 174 "ページ左90度回転 = " & iOutD(OutType.iP90Left) & vbCrLf & _ 175 "ページ右90度回転 = " & iOutD(OutType.iP90Right) & vbCrLf & _ 176 "ページ180度回転 = " & iOutD(OutType.iP180) & vbCrLf & _ 177 "エラー = " & iOutD(OutType.IError) & vbCrLf & _ 178 "Quads値 Max = " & iOutD(OutType.iQuadsMax) 179 Call Put_Degug_log(sOut) 180 If SYORI_MODE = sM.Quads値の展開有 And _ 181 PRINT_MODE = PM.全て And _ 182 msDuegLogCnt <= 3 Then .Range("Z" & i1).Value = "★Z" 183 Call Put_Degug_End 184 DoEvents 185 skip9: 186 Next i1 187 End With 188 189 Call Run_NOTEPAD 190 End Sub 191 192 Private Sub OutGetTextRects( _ 193 ByVal sFilePathIn As String, _ 194 ByRef iOutD() As Long) 195 196 Debug.Print sFilePathIn 197 Debug.Print "Start " & Time 198 199 Erase iOutD 200 201 Dim objAcroApp As New Acrobat.AcroApp 202 Dim objAcroAVDoc As New Acrobat.AcroAVDoc 203 Dim objAcroPDDoc As New Acrobat.AcroPDDoc 204 Dim objAcroPDPage As Acrobat.AcroPDPage 205 Dim objAcroAVPageView As Acrobat.AcroAVPageView 206 Dim objAFormApp As AFORMAUTLib.AFormApp 207 Dim objAFormFields As AFORMAUTLib.Fields 208 Dim objAFormField As AFORMAUTLib.Field 209 210 Dim i1 As Long 211 Dim i1_End As Long 212 Dim i2 As Long 213 Dim i2_End As Long 214 Dim i3 As Long 215 Dim i4 As Long 216 Dim i5 As Long 217 Dim i6 As Long 218 Dim i9 As Long 219 Dim j As Long 220 Dim iCnt As Long 221 Dim iPageNo As Long 222 Dim iPageCnt As Long 223 Dim iRet As Long 224 Dim bRet As Boolean 225 Dim sAJS As String 226 Dim sJsRet As String 227 Dim sOut As String 228 229 Const sAcrobatJavaScript1 = _ 230 "var sOut='';" & _ 231 "var numWords = getPageNumWords(@P);" & _ 232 "for ( var j = 0; j < numWords; j++) {" & _ 233 " nthWord = getPageNthWord(@P,j,false);" & _ 234 " aQuadsFirst = getPageNthWordQuads(@P,j);" & _ 235 " sOut=sOut + j + '\b' + nthWord + '\b' + aQuadsFirst + '\t';" & _ 236 "}" & _ 237 "event.value=sOut;" 238 Const sAcrobatJavaScript2 = _ 239 "var rotation = this.getPageRotation(@P);" & _ 240 "event.value=rotation;" 241 '※特殊文字「\b：バックスペース」「\t：タブ」データの区切り 242 243 244 objAcroApp.CloseAllDocs 245 objAcroApp.Hide '稀にデスクトップに表示されるので隠す 246 247 'PDFファイルを開く 248 bRet = objAcroAVDoc.Open(sFilePathIn, "") 249 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc 250 iPageCnt = objAcroPDDoc.GetNumPages 251 iOutD(OutType.iPageCnt) = iPageCnt 252 253 Set objAFormApp = CreateObject("AFormAut.App") 254 Set objAFormFields = objAFormApp.Fields 255 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc 256 257 Dim sJs_Data() As jsdata 258 ReDim sJs_Data(100) As jsdata 259 Dim sJsText(MAX_GetText) As String 260 Dim sJsZahyo(MAX_GetText, 1024) As String 261 Dim dZahyo(7) As Double 262 263 Dim sJs1_Line() As String 264 Dim sJs2_Line() As String 265 Dim sJs2_Line_Next() As String 266 Dim sJs3_Text As String 267 Dim sJs4_Quads() As String 268 Dim sJs4_Quads_Next() As String 269 270 Dim bTop As Boolean 271 Dim bBottom As Boolean 272 Dim bLeft As Boolean 273 Dim bRight As Boolean 274 275 Dim sWk As String 276 Dim sCheck As String 277 Dim sRet As String 278 Dim sQuads As String 279 Dim sWkQuads As String 280 Dim iTyepSave As Long 281 Dim sTextCRLF As String 282 283 For iPageNo = 0 To iPageCnt - 1 284 285 If Int((iPageNo + 1) / 10) = ((iPageNo + 1) / 10) Then 286 Debug.Print "Page=" & iPageNo + 1 & " " & Time 287 End If 288 DoEvents 289 290 '== Acrobat JavaScriptの編集＆実行 == 291 sAJS = sAcrobatJavaScript2 292 sAJS = Replace(sAJS, "@P", iPageNo) 293 sJsRet = objAFormFields.ExecuteThisJavascript(sAJS) 294 Select Case sJsRet 295 Case 90: iOutD(OutType.iP90Right) = iOutD(OutType.iP90Right) + 1 296 Case 180: iOutD(OutType.iP180) = iOutD(OutType.iP180) + 1 297 Case 270: iOutD(OutType.iP90Left) = iOutD(OutType.iP90Left) + 1 298 End Select 299 If sJsRet <> "0" Then 300 Call Put_Degug_log("Page=" & iPageNo & " 【PageRotation=" & sJsRet & "】") 301 End If 302 303 '== Acrobat JavaScriptの編集＆実行 == 304 sAJS = sAcrobatJavaScript1 305 sAJS = Replace(sAJS, "@P", iPageNo) 306 sJsRet = objAFormFields.ExecuteThisJavascript(sAJS) 307 308 Erase sJsText 309 Erase sJsZahyo 310 Erase sJs_Data 311 ReDim sJs_Data(100) As jsdata 312 313 i9 = 0 314 sJs1_Line = Split(sJsRet, vbTab) 315 316 '■■■ 317 For i1 = 0 To UBound(sJs1_Line) 318 319 If sJs1_Line(i1) = "" Then Exit For 320 321 Erase sJs2_Line 322 323 bTop = False 324 bBottom = False 325 bLeft = False 326 bRight = False 327 sJs3_Text = "" 328 sCheck = "" 329 sQuads = "" 330 sWk = "" 331 sJs_Data(i9).iLineNo = i1 + 1 332 sJs_Data(i9).sStatus = "" 333 334 sJs2_Line = Split(sJs1_Line(i1), vbBack) 335 If UBound(sJs2_Line) <= 1 Then 336 sCheck = sCheck & " ★不良データ(1)" 337 iOutD(OutType.IError) = iOutD(OutType.IError) + 1 338 GoTo Skip_Edit1: 339 End If 340 341 'テキストの事前チェック 342 sJs3_Text = sJs2_Line(1) 343 With sJs_Data(i9) 344 .bSpace = (InStr(sJs3_Text, " ") > 0) 345 .bCRLF = (InStr(sJs3_Text, vbCrLf) > 0) 346 sTextCRLF = Replace(sJs3_Text, vbCrLf, "") 347 .bCR = (InStr(sTextCRLF, vbCr) > 0) 348 .bLF = (InStr(sTextCRLF, vbLf) > 0) 349 End With 350 351 'テキストから不要な制御データを削除 352 sJs3_Text = Replace(sJs3_Text, vbCrLf, "") 353 sJs3_Text = Replace(sJs3_Text, vbCr, "") 354 sJs3_Text = Replace(sJs3_Text, vbLf, "") 355 sJs_Data(i9).sText = Replace(sJs3_Text, " ", "") 356 357 '分解 358 If UBound(sJs2_Line) < 2 Then 359 sCheck = sCheck & " ★不良データ(2)" 360 iOutD(OutType.IError) = iOutD(OutType.IError) + 1 361 GoTo Skip_Edit1: 362 End If 363 'Quads値の整合性チェック 364 If CheckQuads(sJs2_Line(2)) = False Then 365 sCheck = sCheck & " ★Quads値が不良" 366 iOutD(OutType.IError) = iOutD(OutType.IError) + 1 367 GoTo Skip_Edit1: 368 End If 369 370 sQuads = sJs2_Line(2) 371 sJs4_Quads = Split(sJs2_Line(2), ",") 372 ' If UBound(sJs4_Quads) < 7 Or _ 373 ' (Int((UBound(sJs4_Quads) + 1) / 8) <> ((UBound(sJs4_Quads) + 1) / 8)) Then 374 ' sCheck = sCheck & " ★不良データ(3):8の倍数でない" 375 ' iOutD(OutType.IError) = iOutD(OutType.IError) + 1 376 ' GoTo Skip_Edit1: 377 ' End If 378 379 If UBound(sJs4_Quads) > 7 Then 380 iOutD(OutType.i7Over) = iOutD(OutType.i7Over) + 1 381 If iOutD(OutType.iQuadsMax) < UBound(sJs4_Quads) Then _ 382 iOutD(OutType.iQuadsMax) = UBound(sJs4_Quads) 383 sCheck = sCheck & " ★【" & UBound(sJs4_Quads) + 1 & "】" 384 End If 385 sJs_Data(i9).iQuadsCnt = UBound(sJs4_Quads) 386 387 '■■■■■■■■■■■■■■< 展開 >■■■■■■■■■■■■■■ 388 389 If SYORI_MODE = sM.Quads値の展開有 Then GoTo Skip_02: 390 '▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼ 391 '展開・無 392 With sJs_Data(i9) 393 .sQuads = sQuads 394 .iQuadsNo = 0 395 .iType = CheckZahyoTypeQ(.sQuads, .sQuadsT2e) 396 If .iType = zType.iNormal Then '"通常" 397 iOutD(OutType.iNormal) = iOutD(OutType.iNormal) + 1 398 ElseIf .iType = zType.iItalic Then '"イタリック" 399 iOutD(OutType.iItalic) = iOutD(OutType.iItalic) + 1 400 ElseIf .iType = zType.iRight90R Then '"右90度回転" 401 iOutD(OutType.iRight90R) = iOutD(OutType.iRight90R) + 1 402 ElseIf .iType = zType.iLeft90R Then '"左90度回転" 403 iOutD(OutType.iLeft90R) = iOutD(OutType.iLeft90R) + 1 404 ElseIf .iType = zType.i180R Then '"180度回転" 405 iOutD(OutType.i180R) = iOutD(OutType.i180R) + 1 406 ElseIf .iType = zType.iLeft Then '"左向き(1-89)" 407 iOutD(OutType.iLeftR) = iOutD(OutType.iLeftR) + 1 408 ElseIf .iType = zType.iRight Then '"右向き(1-89)" 409 iOutD(OutType.iRightR) = iOutD(OutType.iRightR) + 1 410 ElseIf .iType = zType.iLeft_2 Then '左向き(91-179)回転)" 411 iOutD(OutType.iLeftR_2) = iOutD(OutType.iLeftR_2) + 1 412 ElseIf .iType = zType.iRight_2 Then '右向き(91-179)回転" 413 iOutD(OutType.iRightR_2) = iOutD(OutType.iRightR_2) + 1 414 ElseIf .iType = zType.iEtc Then '"その他" 415 iOutD(OutType.iEtc) = iOutD(OutType.iEtc) + 1 416 End If 417 sCheck = sCheck & " #" & SetTypeNmae(.iType) 418 End With 419 DoEvents 420 421 GoTo Skip_Edit1: 422 423 Skip_02: 424 '▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼ 425 '展開・有 426 If UBound(sJs4_Quads) = 7 Then 427 With sJs_Data(i9) 428 .sQuads = sQuads 429 .iQuadsNo = 0 430 For i4 = 0 To 7 431 .sQuadsT1n(i4) = sJs4_Quads(i4) 432 Next i4 433 End With 434 ElseIf UBound(sJs4_Quads) > 7 Then 435 'Quads値が８以上なので分割して配列に入れる 436 i2_End = (UBound(sJs4_Quads) + 1) / 8 437 i5 = 0 438 For i2 = 1 To i2_End 439 With sJs_Data(i9) 440 .iQuadsNo = i2 441 .sQuads = "" 442 For i4 = 0 To 7 443 .sQuadsT1n(i4) = sJs4_Quads(i5) 444 If .sQuads <> "" Then .sQuads = .sQuads & "," 445 .sQuads = .sQuads & sJs4_Quads(i5) 446 i5 = i5 + 1 447 Next i4 448 End With 449 If i2 < i2_End Then 450 If i9 + 1 > UBound(sJs_Data) Then 451 ReDim Preserve sJs_Data(UBound(sJs_Data) + 100) As jsdata 452 End If 453 '次に今のデータをコピー 454 With sJs_Data(i9 + 1) 455 .iLineNo = sJs_Data(i9).iLineNo 456 .sText = sJs_Data(i9).sText 457 End With 458 i9 = i9 + 1 459 End If 460 Next i2 461 Else 462 Stop '☆プログラムのロジック・エラー☆ 463 End If 464 465 Skip_Edit1: 466 sJs_Data(i9).sStatus = sCheck 467 If i9 + 1 > UBound(sJs_Data) Then 468 ReDim Preserve sJs_Data(UBound(sJs_Data) + 100) As jsdata 469 End If 470 i9 = i9 + 1 471 Skip_Edit1_2: 472 Next i1 473 474 i1_End = i9 - 1 475 If SYORI_MODE = sM.Quads値の展開無 Then GoTo Skip_Output: 476 477 '■■■■■■■■■■■■■■< チェック >■■■■■■■■■■■■■■ 478 479 '展開・有 480 For i1 = 0 To i1_End 481 With sJs_Data(i1) 482 sCheck = .sStatus 483 'Quads値のタイプを出す 484 .iType = CheckZahyoTypeQ(.sQuads, .sQuadsT2e) 485 486 If .iType = zType.iNormal Then '"通常" 487 sCheck = sCheck & " #通常" 488 iOutD(OutType.iNormal) = iOutD(OutType.iNormal) + 1 489 If .iQuadsNo <> 0 Then 490 'Quads値が８以上の配列 ※既にセット済み 491 ' iOutD(OutType.i7Over) = iOutD(OutType.i7Over) + 1 492 End If 493 ' If .sQuadsT2e(JZ.iTop) <> .sQuadsT2e(JZ.iTop2) Then 494 ' sCheck = sCheck & " ★Top" 495 ' End If 496 ' If .sQuadsT2e(JZ.iBottom) <> .sQuadsT2e(JZ.iBottom2) Then 497 ' sCheck = sCheck & " ★Bottom" 498 ' End If 499 ' If .sQuadsT2e(JZ.iLeft) <> .sQuadsT2e(JZ.iLeft2) Then 500 ' sCheck = sCheck & " ★Left" 501 ' End If 502 ' If .sQuadsT2e(JZ.iRight) <> .sQuadsT2e(JZ.iRight2) Then 503 ' sCheck = sCheck & " ★Right" 504 ' End If 505 506 ElseIf .iType = zType.iItalic Then '"イタリック" 507 iOutD(OutType.iItalic) = iOutD(OutType.iItalic) + 1 508 sCheck = sCheck & " #イタリック" 509 ElseIf .iType = zType.iRight90R Then '"右90度回転" 510 iOutD(OutType.iRight90R) = iOutD(OutType.iRight90R) + 1 511 sCheck = sCheck & " #右90度回転" 512 ElseIf .iType = zType.iLeft90R Then '"左90度回転" 513 iOutD(OutType.iLeft90R) = iOutD(OutType.iLeft90R) + 1 514 sCheck = sCheck & " #左90度回転" 515 ElseIf .iType = zType.i180R Then '"180度回転" 516 iOutD(OutType.i180R) = iOutD(OutType.i180R) + 1 517 sCheck = sCheck & " #180度回転" 518 ElseIf .iType = zType.iLeft Then '"左向き(1-89)" 519 iOutD(OutType.iLeftR) = iOutD(OutType.iLeftR) + 1 520 sCheck = sCheck & " #左向き(1-89)回転" 521 ElseIf .iType = zType.iRight Then '"右向き(1-89)" 522 iOutD(OutType.iRightR) = iOutD(OutType.iRightR) + 1 523 sCheck = sCheck & " #右向き(1-89)回転" 524 ElseIf .iType = zType.iLeft_2 Then '左向き(91-179)回転)" 525 iOutD(OutType.iLeftR_2) = iOutD(OutType.iLeftR_2) + 1 526 sCheck = sCheck & " #左向き(91-179)回転" 527 ElseIf .iType = zType.iRight_2 Then '右向き(91-179)回転" 528 iOutD(OutType.iRightR_2) = iOutD(OutType.iRightR_2) + 1 529 sCheck = sCheck & " #右向き(91-179)回転" 530 ElseIf .iType = zType.iEtc Then '"その他" 531 iOutD(OutType.iEtc) = iOutD(OutType.iEtc) + 1 532 sCheck = sCheck & " #その他" 533 End If 534 DoEvents 535 .sStatus = sCheck 536 End With 537 'Skip_Edit: 538 Next i1 539 540 'タイプが途中で変化するかをチェック 541 For i1 = 0 To i1_End 542 With sJs_Data(i1) 543 If .iQuadsNo = 1 Then iTyepSave = .iType 544 If .iQuadsNo > 1 Then 545 If iTyepSave <> .iType Then 546 .sStatus = .sStatus & " ★Type違" 547 iOutD(OutType.iTypeChange) = iOutD(OutType.iTypeChange) + 1 548 End If 549 End If 550 If .iType = zType.iNormal And _ 551 .iQuadsCnt > 8 And _ 552 .iLineNo > 0 Then 553 .sStatus = .sStatus & " ★通常１６" 554 End If 555 End With 556 Next i1 557 558 Skip_Output: 559 '■■■　テキストファイルへの出力 560 For i1 = 0 To i1_End 561 If PRINT_MODE = PM.その他のみ Then 562 If sJs_Data(i1).iType <> zType.iEtc Then GoTo Skip_Output_Next: 563 End If 564 With sJs_Data(i1) 565 sOut = "Page=" & iPageNo & ">" & .iLineNo 566 If SYORI_MODE = sM.Quads値の展開有 Then 567 sOut = sOut & "=" & .iQuadsNo 568 End If 569 sOut = sOut & " (" & .sText & ") " & _ 570 IIf(.bSpace, "-Space", "") & _ 571 IIf(.bCRLF, "-CRLF", "") & _ 572 IIf(.bCR, "-CR", "") & _ 573 IIf(.bLF, "-LF", "") & _ 574 " [" & .sQuads & "] " & .sStatus 575 576 If PRINT_MODE = PM.全て Then 577 Call Put_Degug_log(sOut) 578 ElseIf PRINT_MODE = PM.その他のみ Then 579 Call Put_Degug_log(sOut) 580 ElseIf PRINT_MODE = PM.通常以外 Then 581 If .sStatus <> " #通常" Then 582 Call Put_Degug_log(sOut) 583 End If 584 End If 585 Skip_Output_Next: 586 End With 587 Next i1 588 Next iPageNo 589 590 '変更しないで閉じます。 591 bRet = objAcroAVDoc.Close(False) 592 'Acrobatアプリケーションの終了 593 objAcroApp.Hide 594 objAcroApp.Exit 595 'オブジェクトの開放 596 Set objAcroAVPageView = Nothing 597 Set objAFormFields = Nothing 598 Set objAFormField = Nothing 599 Set objAcroPDPage = Nothing 600 Set objAcroPDDoc = Nothing 601 Set objAcroAVDoc = Nothing 602 Set objAcroApp = Nothing 603 604 Debug.Print "End " & Time 605 End Sub 606 607 Private Function SetTypeNmae(ByVal iNo As Long) As String 608 Select Case iNo 609 Case zType.iNormal '"通常" 610 SetTypeNmae = "通常" 611 Case zType.iItalic '"イタリック" 612 SetTypeNmae = "イタリック" 613 Case zType.iRight90R '"右90度回転" 614 SetTypeNmae = "右90度回転" 615 Case zType.iLeft90R '"左90度回転" 616 SetTypeNmae = "左90度回転" 617 Case zType.i180R '"180度回転" 618 SetTypeNmae = "180度回転" 619 Case zType.iLeft '"左向き(1-89)" 620 SetTypeNmae = "左向き(1-89)回転" 621 Case zType.iRight '"右向き(1-89)" 622 SetTypeNmae = "右向き(1-89)回転" 623 Case zType.iLeft_2 '"左向き(91-179)" 624 SetTypeNmae = "左向き(91-179)回転" 625 Case zType.iRight_2 '"右向き(91-179)" 626 SetTypeNmae = "右向き(91-179)回転" 627 Case zType.iEtc '"その他" 628 SetTypeNmae = "その他" 629 Case Else 630 SetTypeNmae = "" 631 End Select 632 End Function 633 634 Public Function CheckQuads(ByVal sQuads As String) As Boolean 635 On Error GoTo Err_CheckQuads: 636 Dim sWk() As String 637 Dim i1 As Long 638 If Trim(sQuads) = "" Then 639 CheckQuads = False 640 Exit Function 641 End If 642 '配列が７の倍数 643 sWk = Split(sQuads, ",") 644 If UBound(sWk) < 7 Or _ 645 (Int((UBound(sWk) + 1) / 8) <> ((UBound(sWk) + 1) / 8)) Then 646 CheckQuads = False 647 Exit Function 648 End If 649 'データが数値 650 For i1 = 0 To UBound(sWk) 651 If Not IsNumeric(sWk(i1)) Then 652 CheckQuads = False 653 Exit Function 654 End If 655 Next i1 656 CheckQuads = True 657 Exit Function 658 Err_CheckQuads: 659 CheckQuads = False 660 End Function 661 662 Public Function CheckZahyoTypeQ( _ 663 ByVal sQuads As String, _ 664 ByRef dZahyo() As String) As Long 665 666 Dim ax As Double 667 Dim ay As Double 668 Dim bX As Double 669 Dim bY As Double 670 Dim cx As Double 671 Dim cy As Double 672 Dim dx As Double 673 Dim dy As Double 674 675 If Trim(sQuads) = "" Then 676 CheckZahyoTypeQ = zType.iEtc 677 Exit Function 678 End If 679 Dim sWk() As String 680 sWk = Split(sQuads, ",") 681 682 '▼座標の状態からタイプを出す 683 ax = Val(sWk(2)) - Val(sWk(0)) 684 ay = Val(sWk(3)) - Val(sWk(1)) 685 bX = Val(sWk(6)) - Val(sWk(4)) 686 bY = Val(sWk(7)) - Val(sWk(5)) 687 cx = Val(sWk(0)) - Val(sWk(4)) 688 cy = Val(sWk(1)) - Val(sWk(5)) 689 dx = Val(sWk(2)) - Val(sWk(6)) 690 dy = Val(sWk(3)) - Val(sWk(7)) 691 692 Dim i1 As Long 693 For i1 = 0 To 1 694 Select Case True 695 Case (ay = 0 And bY = 0) And _ 696 (ax > 0 And bX > 0 And cy > 0 And dy > 0) 697 CheckZahyoTypeQ = zType.iNormal '"通常" 698 Case (ay = 0 And bY = 0) And _ 699 (ax > 0 And bX > 0 And cy > 0 And dy > 0) 700 CheckZahyoTypeQ = zType.iItalic ' "イタリック" 701 Case (ay = 0 And bY = 0) And _ 702 (ax < 0 And bX < 0 And cy < 0 And dy < 0) 703 CheckZahyoTypeQ = zType.i180R '"180度回転" 704 Case (ax > 0 And ay > 0 And bX > 0 And bY > 0) And _ 705 (cy > 0 And dy > 0) 706 CheckZahyoTypeQ = zType.iLeft '左向き(1-89)回転" 707 Case (ax > 0 And ay < 0 And bX > 0 And bY < 0) And _ 708 (cy > 0 And dy > 0) 709 CheckZahyoTypeQ = zType.iRight '右向き(1-89)回転" 710 Case (ax < 0 And ay > 0 And bX < 0 And bY > 0) And _ 711 (cy < 0 And dy < 0) 712 CheckZahyoTypeQ = zType.iLeft_2 '左向き(91-179)回転" 713 Case (ax < 0 And ay < 0 And bX < 0 And bY < 0) And _ 714 (cy < 0 And dy < 0) 715 CheckZahyoTypeQ = zType.iRight_2 '右向き(91-179)回転" 716 717 '※以下はその他の直前（この位置）で判断しないと駄目 718 Case (ax = 0 And bX = 0) And _ 719 (ay < 0 And bY < 0) 720 CheckZahyoTypeQ = zType.iRight90R '"右90度回転" 721 Case (ax = 0 And bX = 0) And _ 722 (ay > 0 And bY > 0) 723 CheckZahyoTypeQ = zType.iLeft90R '"左90度回転" 724 Case Else 725 '「その他」として扱う 726 CheckZahyoTypeQ = zType.iEtc 'その他 727 End Select 728 729 If CheckZahyoTypeQ <> zType.iEtc Then Exit For 730 731 '「その他」の場合は誤差を考慮して再チェック 732 ax = Val(Format(ax, "0")) 733 ay = Val(Format(ay, "0")) 734 bX = Val(Format(bX, "0")) 735 bY = Val(Format(bY, "0")) 736 cx = Val(Format(cx, "0")) 737 cy = Val(Format(cy, "0")) 738 dx = Val(Format(dx, "0")) 739 dy = Val(Format(dy, "0")) 740 Next i1 741 742 End Function


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

001 Option Explicit 002 003 ' Update : 2020/05/17 004 005 Public msDuegLogCnt As Long 006 Dim msDuegLogFilePath As String 007 Dim mlDuegLogFileNo As Long 008 Dim sDeugMsg As String 009 010 011 '************************************************** 012 ' 013 ' ログ・ファイルの前処理 014 ' 015 '************************************************** 016 017 Public Sub Log_Start(Optional ByVal sFileName As String) 018 019 '実行中の当ファイルが格納されたフォルダのパス 020 msDuegLogFilePath = ThisWorkbook.Path & "\" 'Excel 021 'sPath = Application.CurrentProject.Path 'Access 022 023 msDuegLogCnt = 0 024 mlDuegLogFileNo = FreeFile() 025 If sFileName = "" Then 026 msDuegLogFilePath = msDuegLogFilePath & "\Log-" & _ 027 Format(Date, "yyyymmdd-") & Format(Time, "hhmmss") & ".txt" 028 Else 029 msDuegLogFilePath = msDuegLogFilePath & "" & sFileName & _ 030 "_" & Format(Date, "yyyymmdd-") & Format(Time, "hhmmss") & ".txt" 031 End If 032 sDeugMsg = "Log-File : " & msDuegLogFilePath 033 Call Put_Degug_log(sDeugMsg) 034 035 End Sub 036 037 '************************************************** 038 ' 039 ' LOG の出力 : デバッグ＆確認用 040 ' 041 ' Update: 2020/05/05 042 ' 043 '************************************************** 044 045 Public Sub Put_Degug_log(ByRef sDeug As String) 046 047 DoEvents 048 Open msDuegLogFilePath For Append As #mlDuegLogFileNo 049 Print #mlDuegLogFileNo, " " & sDeug 050 ' Print #mlDuegLogFileNo, _ 051 Format(Date, "yyyy/mm/dd-") & _ 052 Format(Time, "hh:mm:ss ") & _ 053 sDeug '& vbCrLf 054 Close #mlDuegLogFileNo 055 056 sDeug = "" 057 058 msDuegLogCnt = msDuegLogCnt + 1 059 End Sub 060 061 '************************************************** 062 ' 063 ' メモ帳を起動してログを表示 064 ' 065 '************************************************** 066 067 Public Sub Run_NOTEPAD() 068 Dim sMsg As String 069 070 sMsg = "ログの画面を表示しますか？" 071 If msDuegLogCnt > 50 Then 072 sMsg = "ログ内容が沢山あります｡ " & vbCrLf & sMsg 073 End If 074 ' If MsgBox(sMsg, vbInformation + vbOKCancel, "確認") = vbCancel _ 075 ' Then Exit Sub 076 077 mlDuegLogFileNo = 0 078 Dim ReturnValue 079 ReturnValue = Shell("NOTEPAD.EXE " & msDuegLogFilePath, 1) 080 'AppActivate ReturnValue 081 End Sub 082 083 Public Sub Put_Degug_End() 084 mlDuegLogFileNo = 0 085 End Sub 086 087 088 089 090


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

実行結果です。見やすくするために行番号を表示していますが、テキストファイルへは行番号は出力されません。

001 Page=1>762=0 (Using) -Space [409.4388122558594,372.06439208984375,433.31695556640625,372.06439208984375,409.4388122558594,360.94921875,433.31695556640625,360.94921875] #通常 002 Page=1>763=0 (the) -Space [435.84783935546875,372.06439208984375,448.0408630371094,372.06439208984375,435.84783935546875,360.94921875,448.0408630371094,360.94921875] #通常 003 Page=1>764=0 (Save) -Space [450.5717468261719,372.06439208984375,469.603271484375,372.06439208984375,450.5717468261719,360.94921875,469.603271484375,360.94921875] #通常 004 Page=1>765=0 (as) -Space [472.14111328125,372.06439208984375,480.4488220214844,372.06439208984375,472.14111328125,360.94921875,480.4488220214844,360.94921875] #通常 005 Page=1>766=0 (XML) -Space [482.9797058105469,372.06439208984375,505.13275146484375,372.06439208984375,482.9797058105469,360.94921875,505.13275146484375,360.94921875] #通常 006 Page=1>767=1 (Plug-in) -CRLF [507.66363525390625,372.06439208984375,529.3304443359375,372.06439208984375,507.66363525390625,360.94921875,529.3304443359375,360.94921875] #通常 ★通常１６ 007 Page=1>767=2 (Plug-in) [131.45919799804688,360.0645751953125,139.19911193847656,360.0645751953125,131.45919799804688,348.94940185546875,139.19911193847656,348.94940185546875] ★【16】 #通常 008 Page=1>768=0 (」) [139.19911193847656,360.9510498046875,149.15911865234375,360.9510498046875,139.19911193847656,347.79388427734375,149.15911865234375,347.79388427734375] #通常 009 Page=1>769=0 (を) [149.21884155273438,360.9510498046875,159.17884826660156,360.9510498046875,149.21884155273438,347.79388427734375,159.17884826660156,347.79388427734375] #通常 010 Page=1>770=0 (参) [159.2385711669922,360.9510498046875,169.19857788085938,360.9510498046875,159.2385711669922,347.79388427734375,169.19857788085938,347.79388427734375] #通常 011 Page=1>771=0 (照) [169.19863891601562,360.9510498046875,179.1586456298828,360.9510498046875,169.19863891601562,347.79388427734375,179.1586456298828,347.79388427734375] #通常 012 Page=1>772=0 (し) [179.21836853027344,360.9510498046875,189.17837524414062,360.9510498046875,179.21836853027344,347.79388427734375,189.17837524414062,347.79388427734375] #通常 013 Page=1>773=0 (て) [189.23809814453125,360.9510498046875,199.19810485839844,360.9510498046875,189.23809814453125,347.79388427734375,199.19810485839844,347.79388427734375] #通常

以上。

コメントを残す

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

CAPTCHA



SAMURAI Plugin

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

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


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

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