TOP > *
概要
PDF上のテキスト（文字列）と座標を扱う上で最低限必要な知識について、一部ですが解説します。PDF上に存在するテキスト（文字列）をプログラミングで扱う上で必要な情報は３つです。
- 連続したテキスト
- その座標
- ページ番号
これが有れば、テキスト（文字列）をハイライト表示にして目立つようにしたり、取り消し線を入れたり、注釈を追加したり、様々な処理が可能になります。
目次
- 概要 ※ココ
- テキストの区切りの例
- テキストの区切りの条件
- 抽出されたテキスト
- 座標
- 座標の取得はAcrobat JavaScript
- 「３つの情報」を取得するサンプル
- ページ内の全テキスト領域の座標
- 参照
テキストの区切りの例
PDF上のテキストは１文字では無く、「一定の単位」で分割されています。例えば以下の場合
テキストを抽出する時の単位を青線で表示すると以下になります。
※↑↓クリックで拡大表示
青線はテキスト領域の座標を取得し、それを使ってVBA（Acrobat OLE＋Acrobat JavaScript）で描きました。
テキストの区切りの条件
区切りの基本は以下です。
- 半角の英字：次の空白、改行、又は次の全角で区切り
- 半角の数字：次の空白、改行、又は次の全角で区切り
- 半角の記号：出現した後で区切り
- 全角文字：１文字単位で区切り
区切り、分割の条件を変更する設定等は存在しません。ただし、これは上記の画像の様な平坦な文章の場合です。以下の書式が変化する文章では例外が発生します。
- 表紙、裏表紙
- 目次、索引、一覧表
- 絵や図中のテキスト
- 数式や計算式などの記号の塊
テキストと座標の関係が一致しなかったり、テキストの区切りも変化します。複数のテキスト（単語）が区切られないで連続した文字列として扱われる場合もあります。半角文字と全角文字が混ざった状態も存在します。
規則性みたいなモノを見つけて対応出来ないかと、かなり調査してみましたが見つけることは出来ませんでした。
抽出されたテキスト
上記「テキストの区切り」で紹介した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プロパティは以下の １ｘ から ４ｙ までの８つの値を持ちます。各値はテキスト領域の四方座標の値になります。必ず８つの値を１組にしてテキストの座標を表します。
※稀に座標値が無いのも有りますが、その場合は不良として無視して結構です。
PDFはページ左下を基点（0，0）とします。右横方向にX軸、上方向にｙ軸となります。
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を実行します。その結果を受け取り、以下の処理を行います。
- 取得した座標で該当テキストに注釈の四角形の青線を追加
- 追加した注釈に座標のテキストを追加
- テキスト、座標、ページ番号の情報をテキストファイルへ出力
- 入力ファイルの後に「-Square」を追加して同じフォルダに別名で保存
サンプルは関数「OutSquareRectsLog」として作成しています。
- 第１引数：
PDFファイルのフルパスを指定 - 第２引数：
開始ページ番号、－１で先頭ページ指定 - 第３引数：
終了ページ番号、－１で最終ページ指定 - 第４引数：
Trueにすると座標情報のテキストファイルを出力 - 第５引数：
Trueにすると注釈に座標の情報も一緒に表示
以下の画像を参照
注意）処理時間が掛かるので、最初は３頁ほどでテストしてください。
Download：
/p1098_OutSquareRectsLog.zip ( 50.1 KB )
ソースコードの178～204で座標情報の取得は完了しています。
001 Option Explicit
002
003 Private Enum JZ 'JavaScriptから取得のQuads座標
004 iTop = 1
005 iTop2 = 3
006 iBottom = 5
007 iBottom2 = 7
008 iLeft = 0
009 iLeft2 = 4
010 iRight = 2
011 iRight2 = 6
012 End Enum
013 '※ 0[Left] 1[Top] 2[Right] 3[Top]
014 '※ 4[Left] 5[Bottom] 6[Right] 7[Bottom]
015
016
017 Sub Main_Test()
018 Dim bRet As Boolean
019 Dim sInFilePathIn As String
020
021 ' sInFilePathIn = ThisWorkbook.Path & "\test-002.pdf"
022 sInFilePathIn = ThisWorkbook.Path & "\test-x02.pdf"
023
024 ' sInFilePathIn = ThisWorkbook.Path & "\手書きPDF入門-4.pdf"
025 Dim start As Double: start = Timer
026
027 bRet = OutSquareRectsLog(sInFilePathIn, -1, -1, False, True)
028 ' bRet = OutSquareRectsLog(sInFilePathIn, 1, 1, False, True)
029
030 MsgBox "処理時間 = " & Timer - start
031 End Sub
032
033
034 '**************************************************
035 '
036 ' 指定ページに四角の枠を付ける。
037 ' 座標の注釈も追加できる。
038 '
039 ' Create : 2020/04/15
040 ' Update : 2026/03/22
041 ' Vertion : 1.0.3
042
043 ' 引数１ : sInFilePathIn As String (IN)
044 ' 検索するPDFのフルパスdebu
045 '
046 ' 引数２ ：lInPageStart As Long (IN)
047 ' 検索の開始ページ
048 ' 先頭ページは１です
049 ' -1は最初から検索
050 '
051 ' 引数３ ：lInPageEnd As Long (IN)
052 ' 検索の終了ページ
053 ' -1で最終ページまで検索
054 '
055 ' 引数４ ：bOutLog As Boolean (IN)
056 ' True ：座標情報をテキストファイルへ出力
057 ' False：しない
058 '
059 ' 引数５ ：bContents As Boolean (IN)
060 ' True ：座標情報を注釈として追加
061 ' False：しない
062 '
063 ' 戻り値 : True 正常処理
064 ' False エラー処理 PDFで無い
065 '
066 ' URL : https://pdf-file.nnn2.com/?p=1098
067 '
068 ' 備考 ：座標の補正は行ってない。
069 '
070 ' その他 : 著作権等は主張しません。
071 ' 上記URLにコメントを頂けると嬉しいです。
072 '
073 '**************************************************
074
075 Public Function OutSquareRectsLog( _
076 ByVal sInFilePathIn As String, _
077 ByVal lInPageStart As Long, _
078 ByVal lInPageEnd As Long, _
079 ByVal bOutLog As Boolean, _
080 ByVal bContents As Boolean) As Boolean
081
082 On Error GoTo Err_OutSquareRectsLog:
083
084 Dim start As Double: start = Timer
085
086 '初期値
087 OutSquareRectsLog = True
088
089 Dim i1 As Long
090 Dim i2 As Long
091 Dim iPageNo As Long
092 Dim iPageCnt As Long
093 Dim bRet As Boolean
094 Dim iPageStart As Long
095 Dim iPageEnd As Long
096
097 Dim sAJS As String
098 Dim sAJS_MG As String
099 Dim sReturn As String
100 Dim MG_Cnt As Long
101 Dim sWkCon As String
102 Dim sJsText As String
103 Dim sJsWk2() As String
104 Dim sJsWk3() As String
105 Dim sJsQuads() As String
106
107 Dim bCRLF As Boolean
108 Dim bCR As Boolean
109 Dim bLF As Boolean
110 Dim bSpace As Boolean
111
112 Const sAcrobatJavaScript = _
113 "var sOut='';" & _
114 "var numWords = this.getPageNumWords(@P);" & _
115 "for ( var j = 0; j < numWords; j++) {" & _
116 " nthWord = this.getPageNthWord(@P,j,false);" & _
117 " aQuads = this.getPageNthWordQuads(@P,j);" & _
118 " sOut=sOut + j + '\b' + nthWord + " & _
119 "'\b' + aQuads + '\t';" & _
120 "}" & _
121 "event.value=sOut;"
122
123 '※上記の特殊文字はデータの区切りに使用
124 ' （\b：バックスペース）（\t：タブ）
125
126 Const sAcrobatJavaScript2 = _
127 "oRet = this.addAnnot({" & _
128 " type: 'Polygon' ," & _
129 " vertices: [[@1,@2],[@3,@4],[@7,@8],[@5,@6]] ," & _
130 " page:@p ," & _
131 " strokeColor:color.blue ," & _
132 " width:0.3 ," & _
133 "}); "
134 '※type: 'Square' はrectを使う。quadsは使えない。
135 '※type: 'Highlight' はquadsを使う。
136 ' " quads:[[@q]] ," & _
137 '※type: 'Polygon' は多角形はverticesを使う。
138 ' " vertices: [[@1,@2],[@3,@4],[@5,@6],[@7,@8]] ," & _
139 ' " rect:[@1,@2,@3,@4] ," & _
140 ' " @t " & _
141 ' " contents:'@t'," & _
142
143 If Dir$(sInFilePathIn, vbNormal) = "" Then
144 MsgBox sInFilePathIn & vbCrLf & _
145 "ファイルが存在しない。", _
146 vbOKOnly + vbCritical, "実行エラー"
147 OutSquareRectsLog = False
148 Exit Function
149 End If
150
151 'Acrobatオブジェクトの定義＆作成
152 '※ここのオブジェクトをグローバル変数にしては駄目！
153 ' Acrobat 7,8,9,10,11 の時
154 Dim objAcroApp As New Acrobat.AcroApp
155 Dim objAcroAVDoc As New Acrobat.AcroAVDoc
156 Dim objAcroPDDoc As New Acrobat.AcroPDDoc
157 Dim objAcroPDPage As Acrobat.AcroPDPage
158 Dim objAcroAVPageView As Acrobat.AcroAVPageView
159 Dim objAFormApp As New AFORMAUTLib.AFormApp
160 Dim objAFormFields As AFORMAUTLib.Fields
161 Dim objAFormField As AFORMAUTLib.Field
162
163 If bOutLog Then Call Log_Start
164
165 objAcroApp.CloseAllDocs
166 objAcroApp.Hide '稀にデスクトップに表示されるので隠す
167
168 'PDFファイルを開く
169 If objAcroAVDoc.Open(sInFilePathIn, "") = False Then
170 MsgBox "Open出来ません。" & vbCrLf & sInFilePathIn, _
171 vbOKOnly + vbCritical, "実行エラー"
172 OutSquareRectsLog = False
173 GoTo Skip_OutSquareRectsLog_END:
174 End If
175
176 Application.Cursor = xlWait 'マウスポインターを砂時計
177 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
178 iPageStart = IIf(lInPageStart = -1, 0, lInPageStart - 1)
179 iPageEnd = IIf(lInPageEnd = -1, objAcroPDDoc.GetNumPages, lInPageEnd) - 1
180
181 ' Set objAFormApp = CreateObject("AFormAut.App")
182 Set objAFormFields = objAFormApp.Fields
183 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
184
185 sAJS_MG = ""
186 MG_Cnt = 0
187 For iPageNo = iPageStart To iPageEnd
188
189 '▼頁単位で全文字列＋座標を抽出
190
191 'Acrobat JavaScriptの編集
192 sAJS = sAcrobatJavaScript
193 sAJS = Replace(sAJS, "@P", iPageNo)
194 'Acrobat JavaScript の実行
195 DoEvents
196 sReturn = objAFormFields.ExecuteThisJavascript(sAJS)
197 sJsWk2 = Split(sReturn, vbTab)
198
199 Debug.Print "Page=" & iPageNo + 1 & _
200 " Start-Time=" & Time & " Count=" & UBound(sJsWk2) + 1
201
202 For i1 = 0 To UBound(sJsWk2)
203 If sJsWk2(i1) = "" Then Exit For
204 sJsWk3 = Split(sJsWk2(i1), vbBack)
205
206 'テキスト
207 sJsText = sJsWk3(1)
208 If bOutLog Then
209 bSpace = (InStr(sJsText, " ") > 0)
210 bCRLF = (InStr(sJsText, vbCrLf) > 0)
211 bCR = (InStr(sJsText, vbCr) > 0)
212 bLF = (InStr(sJsText, vbLf) > 0)
213 End If
214 sJsText = Replace(sJsText, vbLf, "")
215 sJsText = Replace(sJsText, vbCr, "")
216
217 '座標
218 sJsQuads = Split(sJsWk3(2), ",")
219 sJsText = Replace(sJsText, "'", "''")
220 sAJS = sAcrobatJavaScript2
221 sAJS = Replace(sAJS, "@p", iPageNo)
222 ' sAJS = Replace(sAJS, "@1", sJsQuads(JZ.iLeft))
223 ' sAJS = Replace(sAJS, "@2", sJsQuads(JZ.iBottom))
224 ' sAJS = Replace(sAJS, "@3", sJsQuads(JZ.iRight))
225 ' sAJS = Replace(sAJS, "@4", sJsQuads(JZ.iTop))
226 sAJS = Replace(sAJS, "@1", sJsQuads(0))
227 sAJS = Replace(sAJS, "@2", sJsQuads(1))
228 sAJS = Replace(sAJS, "@3", sJsQuads(2))
229 sAJS = Replace(sAJS, "@4", sJsQuads(3))
230 sAJS = Replace(sAJS, "@5", sJsQuads(4))
231 sAJS = Replace(sAJS, "@6", sJsQuads(5))
232 sAJS = Replace(sAJS, "@7", sJsQuads(6))
233 sAJS = Replace(sAJS, "@8", sJsQuads(7))
234 ' sAJS = Replace(sAJS, "@q", sJsWk3(2))
235 If bContents Then
236 sWkCon = "Text=[" & sJsText & "] " & _
237 " WNo=" & i1 & _
238 " Top=" & sJsQuads(JZ.iTop) & _
239 " Bottom=" & sJsQuads(JZ.iBottom) & _
240 " Left=" & sJsQuads(JZ.iLeft) & _
241 " Right=" & sJsQuads(JZ.iRight)
242 sAJS = Replace(sAJS, "@t", _
243 " contents:'" & sWkCon & "', ")
244 Else
245 sAJS = Replace(sAJS, "@t", "")
246 End If
247
248 '■Acrobat JavaScript の実行
249 sAJS_MG = sAJS_MG & sAJS
250 MG_Cnt = MG_Cnt + 1
251 If MG_Cnt >= 100 Then
252 '※処理時間の短縮の為
253 sReturn = objAFormFields.ExecuteThisJavascript(sAJS_MG)
254 Debug.Print "Page=" & iPageNo + 1 & " i1=" & i1 & _
255 " Time=" & Time
256 sAJS_MG = "": MG_Cnt = 0
257 End If
258 DoEvents
259
260 'テキストファイルの出力
261 If bOutLog Then
262 Call Put_Degug_log( _
263 "Page=" & iPageNo & " " & _
264 " [" & sJsWk3(0) & "] (" & _
265 sJsText & ") " & _
266 IIf(bSpace, "-Space", "") & _
267 IIf(bCRLF, "-CRLF", "") & _
268 IIf(bCR, "-CR", "") & _
269 IIf(bLF, "-LF", "") & _
270 " Top[" & sJsQuads(JZ.iTop) & _
271 "] Bottom[" & sJsQuads(JZ.iBottom) & _
272 "] Left[" & sJsQuads(JZ.iLeft) & _
273 "] Right[" & sJsQuads(JZ.iRight) & "]")
274 End If
275 DoEvents
276 Next i1
277
278 Next iPageNo
279
280 '■Acrobat JavaScript の実行
281 If sAJS_MG <> "" Then
282 '※処理時間の短縮の為
283 sReturn = objAFormFields.ExecuteThisJavascript(sAJS_MG)
284 Debug.Print "Page=" & iPageNo + 1 & " i1=" & i1 & _
285 " Time=" & Time
286 End If
287
288 'PDFファイルを別名で保存
289 Dim sFilePathOut As String
290 sFilePathOut = Replace(sInFilePathIn, ".pdf", "-Square.pdf")
291 If objAcroPDDoc.Save(1, sFilePathOut) = False Then
292 MsgBox "PDFファイルへ保存出来ませんでした", _
293 vbOKOnly + vbCritical, "実行エラー"
294 End If
295
296 Application.Cursor = xlDefault 'マウスポインターを戻す
297 'PDFファイルを閉じる
298 If objAcroAVDoc.Close(False) = False Then
299 MsgBox "AVDocオブジェクトはClose出来ませんでした", _
300 vbOKOnly + vbCritical, "実行エラー"
301 OutSquareRectsLog = False
302 End If
303
304 Skip_OutSquareRectsLog_END:
305
306 On Error Resume Next 'これ以降は強制実行
307
308 Application.Cursor = xlDefault 'マウスポインターを戻す
309 '変更しないで閉じます。
310 bRet = objAcroAVDoc.Close(False)
311 'Acrobatアプリケーションの終了
312 objAcroApp.Hide
313 objAcroApp.Exit
314 'オブジェクトの開放
315 Set objAFormFields = Nothing
316 Set objAFormField = Nothing
317 Set objAFormApp = Nothing
318 Set objAcroAVPageView = Nothing
319 Set objAcroPDPage = Nothing
320 Set objAcroPDDoc = Nothing
321 Set objAcroAVDoc = Nothing
322 Set objAcroApp = Nothing
323
324 If bOutLog Then Call Run_NOTEPAD
325
326 Debug.Print "Total Time = " & Timer - start & _
327 " PageCnt = " & iPageEnd - iPageStart + 1
328
329 Exit Function
330
331 Err_OutSquareRectsLog:
332 MsgBox "処理は以下の理由で中断しました。" & vbCrLf & _
333 vbCrLf & Err.Number & vbCrLf & Err.Description, _
334 vbOKOnly + vbCritical, "実行エラー"
335 OutSquareRectsLog = False
336 GoTo Skip_OutSquareRectsLog_END:
337 End Function
上記サンプルをベースにした関数「文字列のページ番号と座標を返す」も公開しています。テキストを指定するとその座標とページ番号を返します。
ページ内の全テキスト領域の座標
この情報が必要になる事が存在するとは思いませんが、公開します。
以下を見てください。ページの上部にテキストが集中して表示されています。その青線で囲った領域の座標を言います。
それを取得するサンプルです。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
当然ですがヘッダーやフッターが存在すると領域はドンと広がります。
参照
- 関数：文字列のページ番号と座標を返す
- サンプル：テキストにリンクを追加
- サンプル：テキストのリンク数をカウント
- ExecuteThisJavascript
Acrobat OLEからAcrobat JavaScriptを起動
サイト管理人の技術メモ
これ以降はサイト管理者が当サイト又は当ページを維持＆管理するためのメモです。見る必要も無く公開用にも書いてません。
- イタリック文字
- 座標の値が重なる
- 座標のサンプル
- Acrobat OLEの使用はNG
- 同じ行のテキストでも異なる高さの座標
- 同じ行のテキストでも異なる高さの座標（Part2）
- 同じ行のテキストでも異なる高さの座標（Part3）
- Quads値を数値で扱う問題点
- 座標は昇順でない
- 抽出パターンの特徴
- 上記のVBAサンプル
- テキスト（単語）と座標をテキストファイルへ出力
イタリック文字
Quads値の1yと2yのズレで判断できると思ったが、ズレてないPDFも有る。PDF上のイタリック表示とQuads値は一対一では無です。
「PDF上のテキストの位置とQuads値は必ずしも一対一では無い」と言う判断は間違い？
座標の値が重なる
一部のテキストの座標を四角形の注釈で表示。「。」の後と「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）の座標が異なる場合が有る。
各テキストの高さの座標は ※小数点以下は省略
- 「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）の座標が異なる場合が有る。
検証する。以下を実行。
oRet = this.addAnnot({
type: 'Highlight' ,
quads: [[319,644,456,644,397,631,456,631]],
page: 999 ,
strokeColor: color.yellow ,
width: 0.3 ,
});
実行結果は以下。
ここまでをまとめると
- 元のテキストは高さ（Top、Bottom）が異なる座標。
※Acrobatで見るとフォントが異なります。フォントによって座標上の高さも変わると言う事でしょう。（タブン - 手作業でハイライト表示にするとテキストの座標と同じ様に高さが異なるハイライト表示になります。
- 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 で抽出をします。※あくまでもメモ情報。
- パターン①
iRet = objAcroHiliteList.Add( 0 , 32767 )
一括で抽出を開始するパターン- 特徴：
- ページ全体のテキスト抽出が高速で出来る
- テキストの最後の半角空白や改行コードでテキスト（単語）の区切りが判断可能
- 問題点：
- テキスト（単語単位）の座標は取得できない
ページ全体のテキスト領域の座標しか取得できない
- テキスト（単語単位）の座標は取得できない
- 特徴：
- パターン②
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
パターン②：
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
テキスト（単語）と座標をテキストファイルへ出力
テキストの座標関連のロジックを検証するのには、詳細なテキストとその座標の情報が必要。それを作成するサンプルです。テキストファイルへ出力します。
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 ' Update: 2026/3/23
098 '
099 '**************************************************
100
101 Sub Main_XXXX()
102
103 Dim sFilePathIn As String
104 Dim i1 As Long
105 Dim iOutD(19) As Long
106 Dim sOut As String
107
108 With Worksheets("Sheet1")
109
110 SYORI_MODE = sM.Quads値の展開有
111 ' SYORI_MODE = sM.Quads値の展開無
112 PRINT_MODE = PM.全て
113 ' PRINT_MODE = PM.通常以外
114 ' PRINT_MODE = PM.その他のみ
115
116 For i1 = 56 To 56 'Max:571
117
118 sFilePathIn = Trim(.Range("C" & i1).Value)
119 If sFilePathIn = "" Then Exit For
120 If Trim(.Range("B" & i1).Value) <> "" Or _
121 InStr(LCase(sFilePathIn), "test") > 0 Or _
122 InStr(sFilePathIn, "セキュリティ付き") > 0 Then GoTo skip9:
123
124 Call Log_Start(sFilePathIn)
125 sFilePathIn = ThisWorkbook.Path & "\DATA\" & sFilePathIn
126
127 Call Put_Degug_log("【" & i1 & "】 " & sFilePathIn & " " & Time)
128 Call OutGetTextRects(sFilePathIn, iOutD)
129
130 .Range("E" & i1).Value = Time
131 .Range("F" & i1).Value = iOutD(OutType.iPageCnt)
132 .Range("H" & i1).Value = iOutD(OutType.i7Over)
133
134 sOut = "ページ数 = " & iOutD(OutType.iPageCnt) & vbCrLf & _
135 "7Over = " & iOutD(OutType.i7Over) & vbCrLf
136 DoEvents
137 If SYORI_MODE = sM.Quads値の展開有 Then
138 .Range("G" & i1).Value = iOutD(OutType.iNormal)
139 .Range("I" & i1).Value = iOutD(OutType.iItalic)
140 .Range("J" & i1).Value = iOutD(OutType.iLeft90R)
141 .Range("K" & i1).Value = iOutD(OutType.iRight90R)
142 .Range("L" & i1).Value = iOutD(OutType.i180R)
143 .Range("M" & i1).Value = iOutD(OutType.iLeftR)
144 .Range("N" & i1).Value = iOutD(OutType.iRightR)
145 .Range("O" & i1).Value = iOutD(OutType.iLeftR_2)
146 .Range("P" & i1).Value = iOutD(OutType.iRightR_2)
147 .Range("T" & i1).Value = iOutD(OutType.iEtc)
148 .Range("W" & i1).Value = iOutD(OutType.iOver)
149 .Range("V" & i1).Value = iOutD(OutType.iMach)
150 .Range("Y" & i1).Value = iOutD(OutType.iTypeChange)
151 DoEvents
152 End If
153 sOut = sOut & _
154 "通常 = " & iOutD(OutType.iNormal) & vbCrLf & _
155 "イタリック = " & iOutD(OutType.iItalic) & vbCrLf & _
156 "左90度回転 = " & iOutD(OutType.iLeft90R) & vbCrLf & _
157 "右90度回転 = " & iOutD(OutType.iRight90R) & vbCrLf & _
158 "180回転 = " & iOutD(OutType.i180R) & vbCrLf & _
159 "左向き(1-89) = " & iOutD(OutType.iLeftR) & vbCrLf & _
160 "右向き(1-89) = " & iOutD(OutType.iRightR) & vbCrLf & _
161 "左向き(91-179)= " & iOutD(OutType.iLeftR_2) & vbCrLf & _
162 "右向き(91-179)= " & iOutD(OutType.iRightR_2) & vbCrLf & _
163 "その他 = " & iOutD(OutType.iEtc) & vbCrLf & _
164 "Type違い = " & iOutD(OutType.iTypeChange) & vbCrLf & _
165 "Mach = " & iOutD(OutType.iMach) & vbCrLf & _
166 "Over = " & iOutD(OutType.iOver) & vbCrLf
167
168 .Range("Q" & i1).Value = iOutD(OutType.iP90Left)
169 .Range("R" & i1).Value = iOutD(OutType.iP90Right)
170 .Range("S" & i1).Value = iOutD(OutType.iP180)
171 .Range("U" & i1).Value = iOutD(OutType.IError)
172 .Range("X" & i1).Value = iOutD(OutType.iQuadsMax)
173 DoEvents
174 sOut = sOut & _
175 "ページ左90度回転 = " & iOutD(OutType.iP90Left) & vbCrLf & _
176 "ページ右90度回転 = " & iOutD(OutType.iP90Right) & vbCrLf & _
177 "ページ180度回転 = " & iOutD(OutType.iP180) & vbCrLf & _
178 "エラー = " & iOutD(OutType.IError) & vbCrLf & _
179 "Quads値 Max = " & iOutD(OutType.iQuadsMax)
180 Call Put_Degug_log(sOut)
181 If SYORI_MODE = sM.Quads値の展開有 And _
182 PRINT_MODE = PM.全て And _
183 msDuegLogCnt <= 3 Then .Range("Z" & i1).Value = "★Z"
184 Call Put_Degug_End
185 DoEvents
186 skip9:
187 Next i1
188 End With
189
190 Call Run_NOTEPAD
191 End Sub
192
193 Private Sub OutGetTextRects( _
194 ByVal sFilePathIn As String, _
195 ByRef iOutD() As Long)
196
197 Debug.Print sFilePathIn
198 Debug.Print "Start " & Time
199
200 Erase iOutD
201
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 New AFORMAUTLib.AFormApp
208 Dim objAFormFields As AFORMAUTLib.Fields
209 Dim objAFormField As AFORMAUTLib.Field
210
211 Dim i1 As Long
212 Dim i1_End As Long
213 Dim i2 As Long
214 Dim i2_End As Long
215 Dim i3 As Long
216 Dim i4 As Long
217 Dim i5 As Long
218 Dim i6 As Long
219 Dim i9 As Long
220 Dim j As Long
221 Dim iCnt As Long
222 Dim iPageNo As Long
223 Dim iPageCnt As Long
224 Dim iRet As Long
225 Dim bRet As Boolean
226 Dim sAJS As String
227 Dim sJsRet As String
228 Dim sOut As String
229
230 Const sAcrobatJavaScript1 = _
231 "var sOut='';" & _
232 "var numWords = getPageNumWords(@P);" & _
233 "for ( var j = 0; j < numWords; j++) {" & _
234 " nthWord = getPageNthWord(@P,j,false);" & _
235 " aQuadsFirst = getPageNthWordQuads(@P,j);" & _
236 " sOut=sOut + j + '\b' + nthWord + '\b' + aQuadsFirst + '\t';" & _
237 "}" & _
238 "event.value=sOut;"
239 Const sAcrobatJavaScript2 = _
240 "var rotation = this.getPageRotation(@P);" & _
241 "event.value=rotation;"
242 '※特殊文字「\b：バックスペース」「\t：タブ」データの区切り
243
244
245 objAcroApp.CloseAllDocs
246 objAcroApp.Hide '稀にデスクトップに表示されるので隠す
247
248 'PDFファイルを開く
249 bRet = objAcroAVDoc.Open(sFilePathIn, "")
250 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
251 iPageCnt = objAcroPDDoc.GetNumPages
252 iOutD(OutType.iPageCnt) = iPageCnt
253
254 ' Set objAFormApp = CreateObject("AFormAut.App")
255 Set objAFormFields = objAFormApp.Fields
256 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
257
258 Dim sJs_Data() As jsdata
259 ReDim sJs_Data(100) As jsdata
260 Dim sJsText(MAX_GetText) As String
261 Dim sJsZahyo(MAX_GetText, 1024) As String
262 Dim dZahyo(7) As Double
263
264 Dim sJs1_Line() As String
265 Dim sJs2_Line() As String
266 Dim sJs2_Line_Next() As String
267 Dim sJs3_Text As String
268 Dim sJs4_Quads() As String
269 Dim sJs4_Quads_Next() As String
270
271 Dim bTop As Boolean
272 Dim bBottom As Boolean
273 Dim bLeft As Boolean
274 Dim bRight As Boolean
275
276 Dim sWk As String
277 Dim sCheck As String
278 Dim sRet As String
279 Dim sQuads As String
280 Dim sWkQuads As String
281 Dim iTyepSave As Long
282 Dim sTextCRLF As String
283
284 For iPageNo = 0 To iPageCnt - 1
285
286 If Int((iPageNo + 1) / 10) = ((iPageNo + 1) / 10) Then
287 Debug.Print "Page=" & iPageNo + 1 & " " & Time
288 End If
289 DoEvents
290
291 '== Acrobat JavaScriptの編集＆実行 ==
292 sAJS = sAcrobatJavaScript2
293 sAJS = Replace(sAJS, "@P", iPageNo)
294 sJsRet = objAFormFields.ExecuteThisJavascript(sAJS)
295 Select Case sJsRet
296 Case 90: iOutD(OutType.iP90Right) = iOutD(OutType.iP90Right) + 1
297 Case 180: iOutD(OutType.iP180) = iOutD(OutType.iP180) + 1
298 Case 270: iOutD(OutType.iP90Left) = iOutD(OutType.iP90Left) + 1
299 End Select
300 If sJsRet <> "0" Then
301 Call Put_Degug_log("Page=" & iPageNo & " 【PageRotation=" & sJsRet & "】")
302 End If
303
304 '== Acrobat JavaScriptの編集＆実行 ==
305 sAJS = sAcrobatJavaScript1
306 sAJS = Replace(sAJS, "@P", iPageNo)
307 sJsRet = objAFormFields.ExecuteThisJavascript(sAJS)
308
309 Erase sJsText
310 Erase sJsZahyo
311 Erase sJs_Data
312 ReDim sJs_Data(100) As jsdata
313
314 i9 = 0
315 sJs1_Line = Split(sJsRet, vbTab)
316
317 '■■■
318 For i1 = 0 To UBound(sJs1_Line)
319
320 If sJs1_Line(i1) = "" Then Exit For
321
322 Erase sJs2_Line
323
324 bTop = False
325 bBottom = False
326 bLeft = False
327 bRight = False
328 sJs3_Text = ""
329 sCheck = ""
330 sQuads = ""
331 sWk = ""
332 sJs_Data(i9).iLineNo = i1 + 1
333 sJs_Data(i9).sStatus = ""
334
335 sJs2_Line = Split(sJs1_Line(i1), vbBack)
336 If UBound(sJs2_Line) <= 1 Then
337 sCheck = sCheck & " ★不良データ(1)"
338 iOutD(OutType.IError) = iOutD(OutType.IError) + 1
339 GoTo Skip_Edit1:
340 End If
341
342 'テキストの事前チェック
343 sJs3_Text = sJs2_Line(1)
344 With sJs_Data(i9)
345 .bSpace = (InStr(sJs3_Text, " ") > 0)
346 .bCRLF = (InStr(sJs3_Text, vbCrLf) > 0)
347 sTextCRLF = Replace(sJs3_Text, vbCrLf, "")
348 .bCR = (InStr(sTextCRLF, vbCr) > 0)
349 .bLF = (InStr(sTextCRLF, vbLf) > 0)
350 End With
351
352 'テキストから不要な制御データを削除
353 sJs3_Text = Replace(sJs3_Text, vbCrLf, "")
354 sJs3_Text = Replace(sJs3_Text, vbCr, "")
355 sJs3_Text = Replace(sJs3_Text, vbLf, "")
356 sJs_Data(i9).sText = Replace(sJs3_Text, " ", "")
357
358 '分解
359 If UBound(sJs2_Line) < 2 Then
360 sCheck = sCheck & " ★不良データ(2)"
361 iOutD(OutType.IError) = iOutD(OutType.IError) + 1
362 GoTo Skip_Edit1:
363 End If
364 'Quads値の整合性チェック
365 If CheckQuads(sJs2_Line(2)) = False Then
366 sCheck = sCheck & " ★Quads値が不良"
367 iOutD(OutType.IError) = iOutD(OutType.IError) + 1
368 GoTo Skip_Edit1:
369 End If
370
371 sQuads = sJs2_Line(2)
372 sJs4_Quads = Split(sJs2_Line(2), ",")
373 ' If UBound(sJs4_Quads) < 7 Or _
374 ' (Int((UBound(sJs4_Quads) + 1) / 8) <> ((UBound(sJs4_Quads) + 1) / 8)) Then
375 ' sCheck = sCheck & " ★不良データ(3):8の倍数でない"
376 ' iOutD(OutType.IError) = iOutD(OutType.IError) + 1
377 ' GoTo Skip_Edit1:
378 ' End If
379
380 If UBound(sJs4_Quads) > 7 Then
381 iOutD(OutType.i7Over) = iOutD(OutType.i7Over) + 1
382 If iOutD(OutType.iQuadsMax) < UBound(sJs4_Quads) Then _
383 iOutD(OutType.iQuadsMax) = UBound(sJs4_Quads)
384 sCheck = sCheck & " ★【" & UBound(sJs4_Quads) + 1 & "】"
385 End If
386 sJs_Data(i9).iQuadsCnt = UBound(sJs4_Quads)
387
388 '■■■■■■■■■■■■■■< 展開 >■■■■■■■■■■■■■■
389
390 If SYORI_MODE = sM.Quads値の展開有 Then GoTo Skip_02:
391 '▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
392 '展開・無
393 With sJs_Data(i9)
394 .sQuads = sQuads
395 .iQuadsNo = 0
396 .iType = CheckZahyoTypeQ(.sQuads, .sQuadsT2e)
397 If .iType = zType.iNormal Then '"通常"
398 iOutD(OutType.iNormal) = iOutD(OutType.iNormal) + 1
399 ElseIf .iType = zType.iItalic Then '"イタリック"
400 iOutD(OutType.iItalic) = iOutD(OutType.iItalic) + 1
401 ElseIf .iType = zType.iRight90R Then '"右90度回転"
402 iOutD(OutType.iRight90R) = iOutD(OutType.iRight90R) + 1
403 ElseIf .iType = zType.iLeft90R Then '"左90度回転"
404 iOutD(OutType.iLeft90R) = iOutD(OutType.iLeft90R) + 1
405 ElseIf .iType = zType.i180R Then '"180度回転"
406 iOutD(OutType.i180R) = iOutD(OutType.i180R) + 1
407 ElseIf .iType = zType.iLeft Then '"左向き(1-89)"
408 iOutD(OutType.iLeftR) = iOutD(OutType.iLeftR) + 1
409 ElseIf .iType = zType.iRight Then '"右向き(1-89)"
410 iOutD(OutType.iRightR) = iOutD(OutType.iRightR) + 1
411 ElseIf .iType = zType.iLeft_2 Then '左向き(91-179)回転)"
412 iOutD(OutType.iLeftR_2) = iOutD(OutType.iLeftR_2) + 1
413 ElseIf .iType = zType.iRight_2 Then '右向き(91-179)回転"
414 iOutD(OutType.iRightR_2) = iOutD(OutType.iRightR_2) + 1
415 ElseIf .iType = zType.iEtc Then '"その他"
416 iOutD(OutType.iEtc) = iOutD(OutType.iEtc) + 1
417 End If
418 sCheck = sCheck & " #" & SetTypeNmae(.iType)
419 End With
420 DoEvents
421
422 GoTo Skip_Edit1:
423
424 Skip_02:
425 '▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
426 '展開・有
427 If UBound(sJs4_Quads) = 7 Then
428 With sJs_Data(i9)
429 .sQuads = sQuads
430 .iQuadsNo = 0
431 For i4 = 0 To 7
432 .sQuadsT1n(i4) = sJs4_Quads(i4)
433 Next i4
434 End With
435 ElseIf UBound(sJs4_Quads) > 7 Then
436 'Quads値が８以上なので分割して配列に入れる
437 i2_End = (UBound(sJs4_Quads) + 1) / 8
438 i5 = 0
439 For i2 = 1 To i2_End
440 With sJs_Data(i9)
441 .iQuadsNo = i2
442 .sQuads = ""
443 For i4 = 0 To 7
444 .sQuadsT1n(i4) = sJs4_Quads(i5)
445 If .sQuads <> "" Then .sQuads = .sQuads & ","
446 .sQuads = .sQuads & sJs4_Quads(i5)
447 i5 = i5 + 1
448 Next i4
449 End With
450 If i2 < i2_End Then
451 If i9 + 1 > UBound(sJs_Data) Then
452 ReDim Preserve sJs_Data(UBound(sJs_Data) + 100) As jsdata
453 End If
454 '次に今のデータをコピー
455 With sJs_Data(i9 + 1)
456 .iLineNo = sJs_Data(i9).iLineNo
457 .sText = sJs_Data(i9).sText
458 End With
459 i9 = i9 + 1
460 End If
461 Next i2
462 Else
463 Stop '☆プログラムのロジック・エラー☆
464 End If
465
466 Skip_Edit1:
467 sJs_Data(i9).sStatus = sCheck
468 If i9 + 1 > UBound(sJs_Data) Then
469 ReDim Preserve sJs_Data(UBound(sJs_Data) + 100) As jsdata
470 End If
471 i9 = i9 + 1
472 Skip_Edit1_2:
473 Next i1
474
475 i1_End = i9 - 1
476 If SYORI_MODE = sM.Quads値の展開無 Then GoTo Skip_Output:
477
478 '■■■■■■■■■■■■■■< チェック >■■■■■■■■■■■■■■
479
480 '展開・有
481 For i1 = 0 To i1_End
482 With sJs_Data(i1)
483 sCheck = .sStatus
484 'Quads値のタイプを出す
485 .iType = CheckZahyoTypeQ(.sQuads, .sQuadsT2e)
486
487 If .iType = zType.iNormal Then '"通常"
488 sCheck = sCheck & " #通常"
489 iOutD(OutType.iNormal) = iOutD(OutType.iNormal) + 1
490 If .iQuadsNo <> 0 Then
491 'Quads値が８以上の配列 ※既にセット済み
492 ' iOutD(OutType.i7Over) = iOutD(OutType.i7Over) + 1
493 End If
494 ' If .sQuadsT2e(JZ.iTop) <> .sQuadsT2e(JZ.iTop2) Then
495 ' sCheck = sCheck & " ★Top"
496 ' End If
497 ' If .sQuadsT2e(JZ.iBottom) <> .sQuadsT2e(JZ.iBottom2) Then
498 ' sCheck = sCheck & " ★Bottom"
499 ' End If
500 ' If .sQuadsT2e(JZ.iLeft) <> .sQuadsT2e(JZ.iLeft2) Then
501 ' sCheck = sCheck & " ★Left"
502 ' End If
503 ' If .sQuadsT2e(JZ.iRight) <> .sQuadsT2e(JZ.iRight2) Then
504 ' sCheck = sCheck & " ★Right"
505 ' End If
506
507 ElseIf .iType = zType.iItalic Then '"イタリック"
508 iOutD(OutType.iItalic) = iOutD(OutType.iItalic) + 1
509 sCheck = sCheck & " #イタリック"
510 ElseIf .iType = zType.iRight90R Then '"右90度回転"
511 iOutD(OutType.iRight90R) = iOutD(OutType.iRight90R) + 1
512 sCheck = sCheck & " #右90度回転"
513 ElseIf .iType = zType.iLeft90R Then '"左90度回転"
514 iOutD(OutType.iLeft90R) = iOutD(OutType.iLeft90R) + 1
515 sCheck = sCheck & " #左90度回転"
516 ElseIf .iType = zType.i180R Then '"180度回転"
517 iOutD(OutType.i180R) = iOutD(OutType.i180R) + 1
518 sCheck = sCheck & " #180度回転"
519 ElseIf .iType = zType.iLeft Then '"左向き(1-89)"
520 iOutD(OutType.iLeftR) = iOutD(OutType.iLeftR) + 1
521 sCheck = sCheck & " #左向き(1-89)回転"
522 ElseIf .iType = zType.iRight Then '"右向き(1-89)"
523 iOutD(OutType.iRightR) = iOutD(OutType.iRightR) + 1
524 sCheck = sCheck & " #右向き(1-89)回転"
525 ElseIf .iType = zType.iLeft_2 Then '左向き(91-179)回転)"
526 iOutD(OutType.iLeftR_2) = iOutD(OutType.iLeftR_2) + 1
527 sCheck = sCheck & " #左向き(91-179)回転"
528 ElseIf .iType = zType.iRight_2 Then '右向き(91-179)回転"
529 iOutD(OutType.iRightR_2) = iOutD(OutType.iRightR_2) + 1
530 sCheck = sCheck & " #右向き(91-179)回転"
531 ElseIf .iType = zType.iEtc Then '"その他"
532 iOutD(OutType.iEtc) = iOutD(OutType.iEtc) + 1
533 sCheck = sCheck & " #その他"
534 End If
535 DoEvents
536 .sStatus = sCheck
537 End With
538 'Skip_Edit:
539 Next i1
540
541 'タイプが途中で変化するかをチェック
542 For i1 = 0 To i1_End
543 With sJs_Data(i1)
544 If .iQuadsNo = 1 Then iTyepSave = .iType
545 If .iQuadsNo > 1 Then
546 If iTyepSave <> .iType Then
547 .sStatus = .sStatus & " ★Type違"
548 iOutD(OutType.iTypeChange) = iOutD(OutType.iTypeChange) + 1
549 End If
550 End If
551 If .iType = zType.iNormal And _
552 .iQuadsCnt > 8 And _
553 .iLineNo > 0 Then
554 .sStatus = .sStatus & " ★通常１６"
555 End If
556 End With
557 Next i1
558
559 Skip_Output:
560 '■■■ テキストファイルへの出力
561 For i1 = 0 To i1_End
562 If PRINT_MODE = PM.その他のみ Then
563 If sJs_Data(i1).iType <> zType.iEtc Then GoTo Skip_Output_Next:
564 End If
565 With sJs_Data(i1)
566 sOut = "Page=" & iPageNo & ">" & .iLineNo
567 If SYORI_MODE = sM.Quads値の展開有 Then
568 sOut = sOut & "=" & .iQuadsNo
569 End If
570 sOut = sOut & " (" & .sText & ") " & _
571 IIf(.bSpace, "-Space", "") & _
572 IIf(.bCRLF, "-CRLF", "") & _
573 IIf(.bCR, "-CR", "") & _
574 IIf(.bLF, "-LF", "") & _
575 " [" & .sQuads & "] " & .sStatus
576
577 If PRINT_MODE = PM.全て Then
578 Call Put_Degug_log(sOut)
579 ElseIf PRINT_MODE = PM.その他のみ Then
580 Call Put_Degug_log(sOut)
581 ElseIf PRINT_MODE = PM.通常以外 Then
582 If .sStatus <> " #通常" Then
583 Call Put_Degug_log(sOut)
584 End If
585 End If
586 Skip_Output_Next:
587 End With
588 Next i1
589 Next iPageNo
590
591 '変更しないで閉じます。
592 bRet = objAcroAVDoc.Close(False)
593 'Acrobatアプリケーションの終了
594 objAcroApp.Hide
595 objAcroApp.Exit
596 'オブジェクトの開放
597 Set objAcroAVPageView = Nothing
598 Set objAFormFields = Nothing
599 Set objAFormField = Nothing
600 Set objAcroPDPage = Nothing
601 Set objAcroPDDoc = Nothing
602 Set objAcroAVDoc = Nothing
603 Set objAcroApp = Nothing
604
605 Debug.Print "End " & Time
606 End Sub
607
608 Private Function SetTypeNmae(ByVal iNo As Long) As String
609 Select Case iNo
610 Case zType.iNormal '"通常"
611 SetTypeNmae = "通常"
612 Case zType.iItalic '"イタリック"
613 SetTypeNmae = "イタリック"
614 Case zType.iRight90R '"右90度回転"
615 SetTypeNmae = "右90度回転"
616 Case zType.iLeft90R '"左90度回転"
617 SetTypeNmae = "左90度回転"
618 Case zType.i180R '"180度回転"
619 SetTypeNmae = "180度回転"
620 Case zType.iLeft '"左向き(1-89)"
621 SetTypeNmae = "左向き(1-89)回転"
622 Case zType.iRight '"右向き(1-89)"
623 SetTypeNmae = "右向き(1-89)回転"
624 Case zType.iLeft_2 '"左向き(91-179)"
625 SetTypeNmae = "左向き(91-179)回転"
626 Case zType.iRight_2 '"右向き(91-179)"
627 SetTypeNmae = "右向き(91-179)回転"
628 Case zType.iEtc '"その他"
629 SetTypeNmae = "その他"
630 Case Else
631 SetTypeNmae = ""
632 End Select
633 End Function
634
635 Public Function CheckQuads(ByVal sQuads As String) As Boolean
636 On Error GoTo Err_CheckQuads:
637 Dim sWk() As String
638 Dim i1 As Long
639 If Trim(sQuads) = "" Then
640 CheckQuads = False
641 Exit Function
642 End If
643 '配列が７の倍数
644 sWk = Split(sQuads, ",")
645 If UBound(sWk) < 7 Or _
646 (Int((UBound(sWk) + 1) / 8) <> ((UBound(sWk) + 1) / 8)) Then
647 CheckQuads = False
648 Exit Function
649 End If
650 'データが数値
651 For i1 = 0 To UBound(sWk)
652 If Not IsNumeric(sWk(i1)) Then
653 CheckQuads = False
654 Exit Function
655 End If
656 Next i1
657 CheckQuads = True
658 Exit Function
659 Err_CheckQuads:
660 CheckQuads = False
661 End Function
662
663 Public Function CheckZahyoTypeQ( _
664 ByVal sQuads As String, _
665 ByRef dZahyo() As String) As Long
666
667 Dim ax As Double
668 Dim ay As Double
669 Dim bX As Double
670 Dim bY As Double
671 Dim cx As Double
672 Dim cy As Double
673 Dim dx As Double
674 Dim dy As Double
675
676 If Trim(sQuads) = "" Then
677 CheckZahyoTypeQ = zType.iEtc
678 Exit Function
679 End If
680 Dim sWk() As String
681 sWk = Split(sQuads, ",")
682
683 '▼座標の状態からタイプを出す
684 ax = Val(sWk(2)) - Val(sWk(0))
685 ay = Val(sWk(3)) - Val(sWk(1))
686 bX = Val(sWk(6)) - Val(sWk(4))
687 bY = Val(sWk(7)) - Val(sWk(5))
688 cx = Val(sWk(0)) - Val(sWk(4))
689 cy = Val(sWk(1)) - Val(sWk(5))
690 dx = Val(sWk(2)) - Val(sWk(6))
691 dy = Val(sWk(3)) - Val(sWk(7))
692
693 Dim i1 As Long
694 For i1 = 0 To 1
695 Select Case True
696 Case (ay = 0 And bY = 0) And _
697 (ax > 0 And bX > 0 And cy > 0 And dy > 0)
698 CheckZahyoTypeQ = zType.iNormal '"通常"
699 Case (ay = 0 And bY = 0) And _
700 (ax > 0 And bX > 0 And cy > 0 And dy > 0)
701 CheckZahyoTypeQ = zType.iItalic ' "イタリック"
702 Case (ay = 0 And bY = 0) And _
703 (ax < 0 And bX < 0 And cy < 0 And dy < 0)
704 CheckZahyoTypeQ = zType.i180R '"180度回転"
705 Case (ax > 0 And ay > 0 And bX > 0 And bY > 0) And _
706 (cy > 0 And dy > 0)
707 CheckZahyoTypeQ = zType.iLeft '左向き(1-89)回転"
708 Case (ax > 0 And ay < 0 And bX > 0 And bY < 0) And _
709 (cy > 0 And dy > 0)
710 CheckZahyoTypeQ = zType.iRight '右向き(1-89)回転"
711 Case (ax < 0 And ay > 0 And bX < 0 And bY > 0) And _
712 (cy < 0 And dy < 0)
713 CheckZahyoTypeQ = zType.iLeft_2 '左向き(91-179)回転"
714 Case (ax < 0 And ay < 0 And bX < 0 And bY < 0) And _
715 (cy < 0 And dy < 0)
716 CheckZahyoTypeQ = zType.iRight_2 '右向き(91-179)回転"
717
718 '※以下はその他の直前（この位置）で判断しないと駄目
719 Case (ax = 0 And bX = 0) And _
720 (ay < 0 And bY < 0)
721 CheckZahyoTypeQ = zType.iRight90R '"右90度回転"
722 Case (ax = 0 And bX = 0) And _
723 (ay > 0 And bY > 0)
724 CheckZahyoTypeQ = zType.iLeft90R '"左90度回転"
725 Case Else
726 '「その他」として扱う
727 CheckZahyoTypeQ = zType.iEtc 'その他
728 End Select
729
730 If CheckZahyoTypeQ <> zType.iEtc Then Exit For
731
732 '「その他」の場合は誤差を考慮して再チェック
733 ax = Val(Format(ax, "0"))
734 ay = Val(Format(ay, "0"))
735 bX = Val(Format(bX, "0"))
736 bY = Val(Format(bY, "0"))
737 cx = Val(Format(cx, "0"))
738 cy = Val(Format(cy, "0"))
739 dx = Val(Format(dx, "0"))
740 dy = Val(Format(dy, "0"))
741 Next i1
742
743 End Function
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
実行結果です。見やすくするために行番号を表示していますが、テキストファイルへは行番号は出力されません。
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] #通常
以上。