TOP > サンプル/関数 > *

概要

PDFページ上の全テキストを抽出します。テキストはページ単位に以下の内容に編集します。

1. 行単位の文字列
2. 行単位の文字列の座標（計算で出したY座標のみ）
3. ヘッダー（連続するページ上の最上部行。連続行有り）
4. フッター（連続するページ上の最終行。連続行有り）

上記を配列で返します。全て計算で出しているので、期待しない結果が出る可能性が有ります。

詳細

PDFファイルからテキストと同時に取得できる情報は座標（X、Y）だけです。行（行番号）と言う情報は取得できません。英語ならば単語単位、日本語ならば１文字単位の座標（X、Y）で取得します。

参照：PDF上のテキストとその座標

当関数は、同じ行なのか、連続する１行のテキストなのかを座標を見て計算しています。行番号はページ上部からテキストの出現順に１，２，３行目としています。

ヘッダー、フッター以外の本文のみのテキスト検索にも使用できると思っています。

処理動作を変更する定数をいくつか備えていますが、最初はPDFファイルのパスだけを指定して、他はデフォルトで試して下さい。

座標はページ左下を基点とします。

抽出されるテキストの順番

プログラムでは画面上部から表示される順番でテキストの取得はできません。画面トップに表示さていたテキストが途中や最後の場合も有ります。同じ行内のテキストでも順番が前後する場合も有ります。これはPDFファイルの作成時の内容によって変わるみたいです。理由の詳細は不明です。

各テキストは画面表示上の座標（X、Y）を持っています。よって、テキストの順序が前後しても、画面表示では全く問題が出ません。

しかし、順番の前後するテキストをプログラムで扱うとなると問題が出てきます。この関数は座標を見て、画面表示の順（上から下へ、左から右へ）で各テキストを並び替えます。但し、並び替えると問題が出るケースもあります。表内のテキストや索引などのように横に行が複数存在する場合です。並び替えるとテキストのY座標が同じ場合は同じ行と判断してしまうからです。当関数では並び替えをしない指定も出来ます（非推奨！）。

同じ行のテキストと判断する条件

PDF上に以下のようなテキストが存在するとします。

これをプログラムで抽出すると、以下の青枠の単位で分割されて返されます。

「Acrobat 5.05」は「Acrobat」と「5.05」に分割されます。分割方法の指示や変更は出来ません。

当関数は同じ行のテキストと判断する条件を各テキスト横の中心座標の高さの差で行います。

各テキストの中心座標の Y 座標の差が、頁内のテキストの平均的な高さ（Y座標）の１／４の範囲に有れば、同じ行のテキストと判断します。１／４は経験則から出した独自の値です（変更可能：C_DEV 定数）。

ヘッダー、フッターと判断する条件

以下の条件を全て必要とします。

1. 1行目から次ページと同じ位置に同じテキストが存在する時にヘッダーとします。最終行から次ページと同じ位置に同じテキストが存在する時にフッターとします。ヘッダーは下の行へ、フッターは上の行へ連続行の判断もします。
2. 数字と記号以外のテキストが同じ。
   変化するページ番号を無視する為の条件です。「年月日」の文字も無視します。テキストの横方向のX座標は見ません。
3. 前後するページ上のテキストの中心座標Yの差がほぼ同じ。
   テキストの中心座標Yの差は前ページのテキストの平均的な高さの１／４です（変更可能：C_DEV 定数）。
4. 次ページの同じ位置に同じテキストが存在しなくても、ヘッダー行と判断した真下（直下）にある行もヘッダーと見なします。フッターも同様に、次ページの同じ位置に同じテキストが存在しなくても、フッターと判断した真上（直上）にある行もフッターとします。これは１ページ上にしか存在しないヘッダー、又はフッターも取り込む為の機能です。1行でもヘッダー、又はフッターが存在した時に機能します。
   但し、この機能はデフォルトでは無効です。定数で有効に変更できます。
5. ヘッダー、又はフッターと判断した行から離れた位置にある行は判断はしません。稀に本文のトップ行が同じ文字、同じ位置に有る場合があります。デフォルトではテキストの平均高さYの２．５倍以上離れていると無視します。フッターも同様です。

例：

「 XMPデータモデル」行は次ページ上の同じ位置に同じテキストが存在するので、ヘッダーと判断しました。

「プロパティ値」行は次ページの同じ位置にテキストが存在しなくてもヘッダーとして見ることが出来ます（４．の機能）。但し、デフォルでは、この機能は無効になっています。

「構造体」行はヘッダー行の「プロパティ値」から離れているので、ヘッダーの判断はしません（５．の機能）。

「４．」も「５.」もVBAソース内の定数で機能オン・オフに出来ます。

機能

1. 指定したPDFの全テキストを抽出します。
2. 抽出したテキストはY座標に従って並び替えます（推奨）。
   並び替えをしない設定（bSortY = False）も出来ます。
3. テキストのY座標をもとに１行のテキストに結合します。
   結合する前にX座標の順にテキストを並び替えます（推奨）。
   並び替えをしない設定（bSortX = False）も出来ます。
4. 条件を満たした１行目をヘッダー、最終行をフッターとします。連続行も判断します。

形式

Public Function OutSquareRects( _
ByVal sInFilePathIn As String, _
ByRef sOutData() As PageLineZahyo) As Boolean


1. 第１引数（sInFilePathIn）：PDFのフルパスを指定します。
2. 第２引数（sOutData）：処理の結果です。
   詳細は以下の「第２引数：sOutDataの詳細」を参照。

第２引数：sOutDataの詳細

処理結果が「sOutData() As PageLineZahyo」配列に返されます。

'処理の結果
Private Type PageLineZahyo
iLineCount As Long '行数：１～
sLineData(C_MAXLINE) As String '行のテキスト
iLineDataY(C_MAXLINE) As Long '行の中央Y座標
iHeaderCount As Long 'ヘッダー件数：１～
iFooterCount As Long 'フッター件数：１～
bHeaderFlag(C_MAXLINE) As Boolean 'Trueはヘッダー行
bFooterFlag(C_MAXLINE) As Boolean 'Trueはフッター行

'以下は作業用、デバッグ用
bHeaderST(C_MAXLINE) As Boolean 'Trueはヘッダー行・真下
bFooterST(C_MAXLINE) As Boolean 'Trueはフッター行・真上
iAveTextY As Long 'テキストの平均的な高さY
iTextCount As Long '座標を持ったテキスト数
End Type '注：文字数の合計では無い

• iCountLine：ページ内の行数。１は１行。－１、０はゼロ行。
• sLineData( )：ページ内の行データ。配列で返します。
• iLineDataY( )：行データの中心座標のY値。
• iHeaderCount：ヘッダーの数。０は無し。１～
• iFooterCount：フッターの数。０は無し。１～
• bHeaderFlag( )：ヘッダーの有無。sLineDataと同じ位置がTrueならヘッダー。見方は以下を参照。
• bFooterFlag( )：フッターの有無。sLineDataと同じ位置がTrueならフッター。見方は以下を参照。

上記以外は作業用、デバッグ用の変数です。

フッターを見る時は iCountLine の値で配列の最後が判断できます。

戻り値

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

動作検証した環境

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

関数のソース - VBA

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

• Acrobat  OLE の参照設定
• AFormAut の参照設定

Download：  /p1164_Get-HeaderFooter.zip ( 50.2 KB )

001 Option Explicit 002 003 '************************************************** 004 ' 005 ' Create : 2023/03/07 006 ' Update : 2026/03/22 007 ' 008 ' ★の値はテストで出した結果。 009 '************************************************** 010 011 '全体で使用 012 Private Const C_MAXLINE As Long = 200 'ページ中の最大行数 013 Private Const C_DEV As Long = 4 '差計算時の分母 014 015 'Sort_TextData で使用 016 Private Const C1_Y_FIX As Boolean = True 'Y座標の修正 017 Private Const C1_SA As Long = 3 '★差の範囲 Y座標 018 Private Const C1_SORTX As Boolean = True 'X軸ソートの実行 019 Private Const C1_SORTY As Boolean = True 'Y軸ソートの実行 020 021 'Get_Header_Footer で使用 022 '行間が長い行はチェック対象から外す。 023 'True：外す　False：外さない 024 Private Const C2_LONG_HD As Boolean = False 'ヘッダー 025 Private Const C2_LONG_FT As Boolean = False 'フッター 026 Private Const C2_LONG_BAI = 2.5 '★行(高さ)の倍率 027 '真下、真上の行はヘッダー、フッターに取り込む 028 'True：取り込む　False：取り込まない 029 Private Const C2_SHORT_HD As Boolean = True 'ヘッダーの真下 030 Private Const C2_SHORT_FT As Boolean = True 'フッターの真上 031 Private Const C2_SHORT_BAI = 1.3 '★行(高さ)の倍率 032 033 '処理の結果 034 Private Type PageLineZahyo 035 iLineCount As Long '行数：１～ 036 sLineData(C_MAXLINE) As String '行のテキスト 037 iLineDataY(C_MAXLINE) As Long '行の中央Y座標 038 iHeaderCount As Long 'ヘッダー件数：１～ 039 iFooterCount As Long 'フッター件数：１～ 040 bHeaderFlag(C_MAXLINE) As Boolean 'Trueはヘッダー行 041 bFooterFlag(C_MAXLINE) As Boolean 'Trueはフッター行 042 043 '以下は作業用、デバッグ用 044 bHeaderST(C_MAXLINE) As Boolean 'Trueは真下のヘッダー行 045 bFooterST(C_MAXLINE) As Boolean 'Trueは真上のフッター行 046 iAveTextY As Long 'テキストの平均的な高さY 047 iTextCount As Long '座標を持ったテキスト数 048 End Type '注：文字数の合計では無い 049 050 'PDFファイル内のテキストとその座標（一時作業用） 051 Private Type TextZahyo 052 sText As String 'テキスト(編集済み) 053 sTextOrg As String 'テキスト(オリジナル) 054 '※Trime前の状態 055 sTop As String '上部 座標 056 sBottom As String '下部 座標 057 sLeft As String '左 座標 058 sRight As String '右　 座標 059 iLineNo As Long '行番号 060 iCenterX As Long '中心座標 X 061 iCenterY As Long '中心座標 Y 062 End Type 063 064 'Acrobat JavaScriptから取得のQuads座標 065 Private Enum JsZahyo 066 iTop = 1 067 iBottom = 5 068 iLeft = 0 069 iRight = 2 070 End Enum 071 '※ 0[Left] 1[Top] 2[Right] 3[Top] 072 '※ 4[Left] 5[Bottom] 6[Right] 7[Bottom] 073 074 Private msMsg As String 'メッセージ 075 ' VBA RunTime Error 対応用 076 Private miErrorNo As Long 'Err.Number の内容 077 Private msErrorMsg As String 'Err.Description の内容 078 079 '************************************************** 080 ' 081 ' 関数を呼び出すテスト用 082 ' 083 ' Create : 2023/03/07 084 ' 085 '************************************************** 086 Sub Main_Test() 087 088 '▼メモリ上のAcrobatプロセスを確認する 089 If iCheckAcrobat() > 0 Then 090 msMsg = "Acrobatが動いています。" _ 091 & vbCrLf & "処理を中断します。" & vbCrLf _ 092 & vbCrLf & "この後でAcrobatの終了を試みます。" 093 MsgBox msMsg, vbCritical, "実行の中断" 094 'Acrobat OLEの終了を試みる 095 Call EndAcrobat 096 Exit Sub 097 End If 098 099 Dim bRet As Boolean '関数の戻り値 100 Dim sInFilePathIn As String 'PDFファイル 101 Dim sOutData() As PageLineZahyo 'テキストと座標 102 103 'PDF内の全テキストと座標を取得 104 sInFilePathIn = ThisWorkbook.Path & "\Test22.pdf" 105 bRet = OutSquareRects(sInFilePathIn, sOutData) 106 If bRet = False Then Exit Sub 107 108 '===================================== 109 '結果をテキスト出力し、メモ帳も起動する 110 Call WriteLog(sInFilePathIn, sOutData) 111 End Sub 112 113 '************************************************** 114 ' 115 ' PDF内の全テキストを抽出し、行データを作成する。 116 ' ヘッダー、フッターの情報も作成する。 117 ' 118 ' Create : 2023/02/28 119 ' Update : 2026/03/22 120 ' 121 ' 引数１ : sInFilePathIn As String (IN) 122 ' 入力するPDFファイルのフルパス 123 ' 124 ' 引数２ : sOutData() As PageLineZahyo (OUT) 125 ' PDFファイル内の 126 ' ・行とそのY座標 127 ' ・ヘッダー、フッター 128 ' 129 ' 戻り値 : True 正常 130 ' False エラー、PDFが無い、等 131 ' 132 ' 参照設定： 133 ' Acrobat (Adobe Acrobat **.* Type Library) 134 ' AFormAut 1.0 Type Library 135 ' 136 '************************************************** 137 Public Function OutSquareRects( _ 138 ByVal sInFilePathIn As String, _ 139 ByRef sOutData() As PageLineZahyo) As Boolean 140 141 'On Error GoTo Err_OutSquareRects: 142 OutSquareRects = True 143 Dim start As Double: start = Timer 144 145 Dim i1 As Long 146 Dim i2 As Long 147 Dim iPageNo As Long 148 Dim iPageEnd As Long 149 Dim bRet As Boolean 150 151 Dim sAJS As String 152 Dim sReturn As String 153 Dim sJsText As String 154 Dim sJsTextOrg As String 155 Dim sJsWk2() As String 156 Dim sJsWk3() As String 157 Dim sJsQuads() As String 158 159 Dim sTextDT() As TextZahyo '作業用 160 161 'テキストの座標を取得するAcrobat JavScript 162 Const sAcrobatJavaScript = _ 163 "var sOut='';" & _ 164 "var numWords = this.getPageNumWords(@P);" & _ 165 "for ( var j = 0; j < numWords; j++) {" & _ 166 " nthWord = this.getPageNthWord(@P,j,false);" & _ 167 " aQuads = this.getPageNthWordQuads(@P,j);" & _ 168 " sOut=sOut + j + '\b' + nthWord + " & _ 169 "'\b' + aQuads + '\t';" & _ 170 "}" & _ 171 "event.value=sOut;" 172 '※下記の特殊文字はデータの区切りに使用 173 '　 \b：バックスペース 174 ' \t：タブ 175 176 If Dir$(sInFilePathIn, vbNormal) = "" Then 177 MsgBox sInFilePathIn & vbCrLf & _ 178 "ファイルが存在しない。", _ 179 vbOKOnly + vbCritical, "実行エラー" 180 OutSquareRects = False 181 Exit Function 182 End If 183 184 'Acrobatオブジェクトの定義＆作成 185 Dim objAcroApp As New Acrobat.AcroApp 186 Dim objAcroAVDoc As New Acrobat.AcroAVDoc 187 Dim objAcroPDDoc As New Acrobat.AcroPDDoc 188 Dim objAFormApp As New AFORMAUTLib.AFormApp 189 Dim objAFormFields As AFORMAUTLib.Fields 190 191 '前回のエラー終了時の事前対応 192 objAcroApp.CloseAllDocs 193 objAcroApp.Hide '稀にデスクトップに表示されるので隠す 194 195 'PDFファイルを開く 196 If objAcroAVDoc.Open(sInFilePathIn, "") = False Then 197 MsgBox "Open出来ません。" & vbCrLf & sInFilePathIn, _ 198 vbOKOnly + vbCritical, "実行エラー" 199 OutSquareRects = False 200 GoTo Skip_OutSquareRects_END: 201 End If 202 203 Application.Cursor = xlWait 'マウスポインターを砂時計 204 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc 205 iPageEnd = objAcroPDDoc.GetNumPages - 1 206 ' Set objAFormApp = CreateObject("AFormAut.App") 207 Set objAFormFields = objAFormApp.Fields 208 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc 209 210 'ページ単位のテキストデータ 211 ReDim sOutData(iPageEnd) As PageLineZahyo 212 213 For iPageNo = 0 To iPageEnd 214 215 DoEvents 'CPUを一時的に返す 216 '頁単位で全文字列＋座標を抽出 217 218 'Acrobat JavaScriptの編集 219 sAJS = sAcrobatJavaScript 220 sAJS = Replace(sAJS, "@P", iPageNo) 221 'Acrobat JavaScript の実行 222 sReturn = objAFormFields.ExecuteThisJavascript(sAJS) 223 sJsWk2 = Split(sReturn, vbTab) 224 225 Debug.Print "Page=" & iPageNo + 1 & _ 226 " Start-Time=" & Time & " Count=" & _ 227 UBound(sJsWk2) + 1 228 229 '結果の編集 230 i2 = -1 231 If UBound(sJsWk2) >= 0 Then 232 ReDim sTextDT(UBound(sJsWk2)) As TextZahyo 233 End If 234 235 For i1 = 0 To UBound(sJsWk2) 236 If sJsWk2(i1) = "" Then Exit For 237 238 sJsWk3 = Split(sJsWk2(i1), vbBack) 239 sJsQuads = Split(sJsWk3(2), ",") 240 sJsText = sJsWk3(1) 241 sJsText = Replace(sJsText, vbCr, "") 242 sJsText = Replace(sJsText, vbLf, "") 243 sJsTextOrg = sJsText 244 sJsText = Trim$(sJsText) 245 If sJsText <> "" Then 246 i2 = i2 + 1 247 With sTextDT(i2) 248 .sText = sJsText 249 .sTextOrg = sJsTextOrg 250 .sTop = sJsQuads(JsZahyo.iTop) 251 .sBottom = sJsQuads(JsZahyo.iBottom) 252 .sLeft = sJsQuads(JsZahyo.iLeft) 253 .sRight = sJsQuads(JsZahyo.iRight) 254 '初期化 255 .iLineNo = -1 256 .iCenterX = -1 257 .iCenterY = -1 258 End With 259 End If 260 Next i1 261 262 sOutData(iPageNo).iTextCount = i2 263 If i2 >= 0 Then 264 ReDim Preserve sTextDT(i2) As TextZahyo 265 266 '▼全テキストの[平均の高さ]と[中心座標]を求める 267 bRet = EditYobiData(iPageNo, sOutData(), sTextDT) 268 If bRet = False Then 269 OutSquareRects = False 270 Exit For 271 End If 272 273 '▼テキストの中心座標を基に全テキストのソートを行う 274 bRet = Sort_TextData(iPageNo, sOutData(), sTextDT) 275 If bRet = False Then 276 OutSquareRects = False 277 Exit For 278 End If 279 280 '▼テキストデータから行データを作成 281 bRet = MargTextLine(iPageNo, sOutData(), sTextDT) 282 If bRet = False Then 283 OutSquareRects = False 284 Exit For 285 End If 286 End If 287 288 Next iPageNo 289 290 '▼ヘッダー、フッターを抽出 291 bRet = Get_Header_Footer(sOutData) 292 ' If bRet = False Then Exit Sub 293 294 Application.Cursor = xlDefault 'マウスポインターを戻す 295 'PDFファイルを閉じる 296 If objAcroAVDoc.Close(False) = False Then 297 MsgBox "AVDocオブジェクトはClose出来ませんでした", _ 298 vbOKOnly + vbCritical, "実行エラー" 299 OutSquareRects = False 300 End If 301 302 Skip_OutSquareRects_END: 303 304 On Error Resume Next 'これ以降は強制実行 305 306 Application.Cursor = xlDefault 'マウスポインターを戻す 307 '変更しないで閉じます。 308 bRet = objAcroAVDoc.Close(False) 309 'Acrobatアプリケーションの終了 310 objAcroApp.Hide 311 objAcroApp.Exit 312 'オブジェクトの強制開放 313 Set objAFormFields = Nothing 314 Set objAFormApp = Nothing 315 Set objAcroPDDoc = Nothing 316 Set objAcroAVDoc = Nothing 317 Set objAcroApp = Nothing 318 319 Debug.Print "Total Time = " & Timer - start & _ 320 " PageCnt = " & iPageEnd + 1 321 322 Exit Function 323 324 Err_OutSquareRects: 325 MsgBox "処理は以下の理由で中断しました。" & vbCrLf & _ 326 vbCrLf & Err.Number & vbCrLf & Err.Description, _ 327 vbOKOnly + vbCritical, "OutSquareRects：実行エラー" 328 OutSquareRects = False 329 GoTo Skip_OutSquareRects_END: 330 End Function 331 332 '************************************************** 333 ' 334 ' データの中間加工 335 ' 336 '　・全テキストの平均・高さを求める 337 '　・全テキストの中心座標を求める 338 ' 339 ' Create : 2023/03/07 340 ' 341 ' ※ココで求める値は整数値で十分 342 ' 343 '************************************************** 344 Private Function EditYobiData( _ 345 ByVal iPageNo As Long, _ 346 ByRef sOutData() As PageLineZahyo, _ 347 ByRef sTextDT() As TextZahyo) As Boolean 348 349 EditYobiData = True 350 351 Dim i1 As Long 352 Dim iAll As Long 'テキストの高さの集計 353 Dim iHi As Long '計算用作業 354 355 iAll = 0 356 For i1 = 0 To UBound(sTextDT) 357 With sTextDT(i1) 358 iHi = Round(Val(.sTop) - Val(.sBottom)) 359 'テキストの高さの集計 360 iAll = iAll + iHi 361 'テキストの中心座標 362 .iCenterY = Round(Val(.sTop) - (iHi / 2)) 363 iHi = Val(.sRight) - Val(.sLeft) 364 .iCenterX = Round(Val(.sRight) - (iHi / 2)) 365 '初期化 366 .iLineNo = -1 367 End With 368 Next i1 369 370 With sOutData(iPageNo) 371 If .iTextCount = -1 Then 372 .iAveTextY = -1 373 Else 374 'ページ単位のテキストの平均的な高さ 375 .iAveTextY = Round(iAll / (.iTextCount + 1)) 376 End If 377 End With 378 379 End Function 380 381 '************************************************** 382 ' 383 ' テキストの中心座標を基に全テキストをソートする 384 ' 385 ' Create : 2023/03/08 386 ' Update : 2023/03/12 387 ' 388 ' 注：(C1_Y_FIX=True)で行間（座標Y）が小さい場合(差:3)は 389 '　　先頭行と同じ座標Yに強制修正する。同じ行内でも 390 '　　高さが少し異なるテキストを同じ行とする為の処理です。 391 '　　このようなテキストは非常に多い。 392 '************************************************** 393 Private Function Sort_TextData( _ 394 ByVal iPageNo As Long, _ 395 ByRef sOutData() As PageLineZahyo, _ 396 ByRef sTextDT() As TextZahyo) As Boolean 397 398 Sort_TextData = True 399 400 Dim iSa As Long '計算の差 401 Dim i1 As Long 402 Dim i2 As Long 403 Dim iEndInx As Long 404 Dim w_sText As String 'テキスト 405 Dim w_sTextOrg As String 'テキスト(オリジナル) 406 Dim w_sTop As String '上部 座標 407 Dim w_sBottom As String '下部 座標 408 Dim w_sLeft As String '左 座標 409 Dim w_sRight As String '右　 座標 410 Dim w_iLineNo As Long '行番号 411 Dim w_iCenterX As Long '中心座標 X 412 Dim w_iCenterY As Long '中心座標 Y 413 Dim iLineSeqNo As Long '行番号 414 Dim iHeightAve As Long 'テキストの平均的な高さ 415 416 iEndInx = sOutData(iPageNo).iTextCount 417 418 '▼Y軸座標でソート 419 If C1_SORTY Then 420 For i1 = 0 To iEndInx - 1 421 For i2 = i1 + 1 To iEndInx 422 If sTextDT(i1).iCenterY < sTextDT(i2).iCenterY Then 423 w_sText = sTextDT(i1).sText 424 w_sTextOrg = sTextDT(i1).sTextOrg 425 w_sTop = sTextDT(i1).sTop 426 w_sBottom = sTextDT(i1).sBottom 427 w_sLeft = sTextDT(i1).sLeft 428 w_sRight = sTextDT(i1).sRight 429 w_iCenterX = sTextDT(i1).iCenterX 430 w_iCenterY = sTextDT(i1).iCenterY 431 432 sTextDT(i1).sText = sTextDT(i2).sText 433 sTextDT(i1).sTextOrg = sTextDT(i2).sTextOrg 434 sTextDT(i1).sTop = sTextDT(i2).sTop 435 sTextDT(i1).sBottom = sTextDT(i2).sBottom 436 sTextDT(i1).sLeft = sTextDT(i2).sLeft 437 sTextDT(i1).sRight = sTextDT(i2).sRight 438 sTextDT(i1).iCenterX = sTextDT(i2).iCenterX 439 sTextDT(i1).iCenterY = sTextDT(i2).iCenterY 440 441 sTextDT(i2).sText = w_sText 442 sTextDT(i2).sTextOrg = w_sTextOrg 443 sTextDT(i2).sTop = w_sTop 444 sTextDT(i2).sBottom = w_sBottom 445 sTextDT(i2).sLeft = w_sLeft 446 sTextDT(i2).sRight = w_sRight 447 sTextDT(i2).iCenterX = w_iCenterX 448 sTextDT(i2).iCenterY = w_iCenterY 449 End If 450 Next i2 451 Next i1 452 '微妙な座標Y誤差の修正 453 If C1_Y_FIX Then 454 For i1 = 0 To iEndInx - 1 455 iSa = Abs(sTextDT(i1).iCenterY - _ 456 sTextDT(i1 + 1).iCenterY) 457 If (0 < iSa) And (iSa <= C1_SA) Then 458 sTextDT(i1 + 1).iCenterY = _ 459 sTextDT(i1).iCenterY 460 End If 461 Next i1 462 End If 'End IF (C1_Y_FIX) 463 End If 'End If (bSortY) 464 465 '▼行番号を追加します。Y座標で判断する。 466 If sOutData(iPageNo).iTextCount = -1 Then 467 sOutData(iPageNo).iLineCount = -1 468 Else 469 iLineSeqNo = 1 470 iHeightAve = Round(sOutData(iPageNo).iAveTextY / C_DEV) 471 '※下記にしたら影響するのは本文のみ。 472 ' iHeightAve = 0 473 For i1 = 0 To iEndInx - 1 474 sTextDT(i1).iLineNo = iLineSeqNo 475 For i2 = i1 + 1 To iEndInx 476 If Abs((sTextDT(i1).iCenterY - _ 477 sTextDT(i2).iCenterY)) <= iHeightAve Then 478 '行番号を設定 479 sTextDT(i2).iLineNo = iLineSeqNo 480 Else 481 i1 = i2 - 1 482 iLineSeqNo = iLineSeqNo + 1 483 Exit For 484 End If 485 Next i2 486 Next i1 487 If sTextDT(iEndInx).iLineNo = -1 Then 488 sTextDT(iEndInx).iLineNo = iLineSeqNo 489 End If 490 sOutData(iPageNo).iLineCount = iLineSeqNo 491 End If 492 493 '▼行番号単位でX軸ソート 494 If C1_SORTX Then 495 If sOutData(iPageNo).iTextCount <> -1 Then 496 iLineSeqNo = -1 497 For i1 = 0 To iEndInx - 1 498 For i2 = i1 + 1 To iEndInx 499 If sTextDT(i1).iLineNo <> sTextDT(i2).iLineNo _ 500 Then Exit For 501 If sTextDT(i1).iCenterX > sTextDT(i2).iCenterX Then 502 w_sText = sTextDT(i1).sText 503 w_sTextOrg = sTextDT(i1).sTextOrg 504 w_sTop = sTextDT(i1).sTop 505 w_sBottom = sTextDT(i1).sBottom 506 w_sLeft = sTextDT(i1).sLeft 507 w_sRight = sTextDT(i1).sRight 508 w_iLineNo = sTextDT(i1).iLineNo 509 w_iCenterX = sTextDT(i1).iCenterX 510 w_iCenterY = sTextDT(i1).iCenterY 511 512 sTextDT(i1).sText = sTextDT(i2).sText 513 sTextDT(i1).sTextOrg = sTextDT(i2).sTextOrg 514 sTextDT(i1).sTop = sTextDT(i2).sTop 515 sTextDT(i1).sBottom = sTextDT(i2).sBottom 516 sTextDT(i1).sLeft = sTextDT(i2).sLeft 517 sTextDT(i1).sRight = sTextDT(i2).sRight 518 sTextDT(i1).iLineNo = sTextDT(i2).iLineNo 519 sTextDT(i1).iCenterX = sTextDT(i2).iCenterX 520 sTextDT(i1).iCenterY = sTextDT(i2).iCenterY 521 522 sTextDT(i2).sText = w_sText 523 sTextDT(i2).sTextOrg = w_sTextOrg 524 sTextDT(i2).sTop = w_sTop 525 sTextDT(i2).sBottom = w_sBottom 526 sTextDT(i2).sLeft = w_sLeft 527 sTextDT(i2).sRight = w_sRight 528 sTextDT(i2).iLineNo = w_iLineNo 529 sTextDT(i2).iCenterX = w_iCenterX 530 sTextDT(i2).iCenterY = w_iCenterY 531 End If 532 Next i2 533 Next i1 534 End If 535 End If 'End If (bSortX) 536 537 End Function 538 539 '************************************************** 540 ' 541 ' 行データを作成 542 ' 543 ' Create : 2023/03/07 544 ' 545 '************************************************** 546 Private Function MargTextLine( _ 547 ByVal iPageNo As Long, _ 548 ByRef sOutData() As PageLineZahyo, _ 549 ByRef sTextDT() As TextZahyo) As Boolean 550 MargTextLine = True 551 552 Dim i1 As Long 553 Dim i2 As Long 554 555 '初期化 556 For i1 = 0 To UBound(sOutData(iPageNo).sLineData) 557 sOutData(iPageNo).sLineData(i1) = "" 558 sOutData(iPageNo).iLineDataY(i1) = -1 559 Next i1 560 561 '行番号単位に行テキストを作成 562 For i1 = 0 To UBound(sTextDT) 563 i2 = sTextDT(i1).iLineNo - 1 564 With sOutData(iPageNo) 565 .sLineData(i2) = _ 566 .sLineData(i2) & sTextDT(i1).sTextOrg 567 .iLineDataY(i2) = sTextDT(i1).iCenterY 568 End With 569 Next i1 570 571 End Function 572 573 '************************************************** 574 ' 575 ' ヘッダー、フッターの判断 576 ' 577 ' Create : 2023/03/07 578 ' Update : 2023/03/12 579 ' 580 ' 　ヘッダー、フッターの抽出条件： 581 ' 文字列＋連続頁＋前後ページでの高さ(Y)が同じ 582 ' 583 ' C2_LONG_HD,C2_LONG_FTをTrueにすると行間が長い行は 584 ' 比較対象から外す。（推奨） 585 ' 586 '************************************************** 587 Private Function Get_Header_Footer( _ 588 ByRef sOutData() As PageLineZahyo) As Boolean 589 590 Get_Header_Footer = True 591 592 Dim iPageNo As Long 'ページ番号 593 Dim iNextPg As Long '次のページ番号 594 Dim i1 As Long 595 Dim i2 As Long 596 Dim iHeaderEnd As Long 'ヘッダー最終処理の位置 597 Dim iFooterEnd As Long 'フッター最終処理の位置 598 Dim iSa As Long '差 599 600 '初期化 601 For iPageNo = 0 To UBound(sOutData) 602 With sOutData(iPageNo) 603 For i1 = 0 To C_MAXLINE 604 .bHeaderFlag(i1) = False 605 .bFooterFlag(i1) = False 606 .bHeaderST(i1) = False 'デバッグ用 607 .bFooterST(i1) = False 'デバッグ用 608 Next i1 609 End With 610 Next iPageNo 611 612 '■ヘッダー、フッター 613 For iPageNo = 0 To UBound(sOutData) 614 If sOutData(iPageNo).iLineCount < 0 Then _ 615 GoTo Next_Get_Header_Footer: 616 617 iNextPg = iPageNo + 1 618 619 '▼ヘッダーの編集 620 iHeaderEnd = -1 621 '当ページと次ページとの比較 622 If iPageNo < UBound(sOutData) Then 623 iSa = Round(sOutData(iPageNo).iAveTextY / C_DEV) 624 For i1 = 0 To sOutData(iPageNo).iLineCount - 1 625 If (DeleteText(sOutData(iPageNo).sLineData(i1)) = _ 626 DeleteText(sOutData(iNextPg).sLineData(i1))) _ 627 And Abs(sOutData(iPageNo).iLineDataY(i1) - _ 628 sOutData(iNextPg).iLineDataY(i1)) <= iSa _ 629 Then 630 If C2_LONG_HD And (i1 > 0) Then 631 '１行上との行間が大きい時はヘッダーにしない。 632 If Abs(sOutData(iPageNo).iLineDataY(i1 - 1) - _ 633 sOutData(iPageNo).iLineDataY(i1)) > _ 634 (sOutData(iPageNo).iAveTextY * _ 635 C2_LONG_BAI) Then 636 Exit For 637 End If 638 End If 639 sOutData(iPageNo).bHeaderFlag(i1) = True 640 sOutData(iNextPg).bHeaderFlag(i1) = True 641 iHeaderEnd = i1 642 Else 643 Exit For 644 End If 645 Next i1 646 End If 647 For i1 = sOutData(iPageNo).iLineCount - 1 To 0 Step -1 648 If sOutData(iPageNo).bHeaderFlag(i1) Then 649 iHeaderEnd = i1 650 Exit For 651 End If 652 Next i1 653 654 'ヘッダーの真下の近い行はヘッダーとする 655 If C2_SHORT_HD And (iHeaderEnd <> -1) Then 656 '真下の行はヘッダーとして取り込む 657 With sOutData(iPageNo) 658 iSa = .iAveTextY * C2_SHORT_BAI 659 For i2 = (iHeaderEnd + 1) To (.iLineCount - 1) 660 If Abs(.iLineDataY(i2 - 1) - _ 661 .iLineDataY(i2)) <= iSa Then 662 .bHeaderFlag(i2) = True 663 .bHeaderST(i2) = True 664 Else 665 Exit For 666 End If 667 Next i2 668 End With 669 End If 670 671 '▼フッターの編集 672 iFooterEnd = -1 673 If iPageNo < UBound(sOutData) Then 674 i2 = sOutData(iNextPg).iLineCount - 1 675 '当ページと次ページとの比較 676 If (i2 >= 0) And (iPageNo < UBound(sOutData)) Then 677 iSa = Round(sOutData(iPageNo).iAveTextY / C_DEV) 678 For i1 = sOutData(iPageNo).iLineCount - 1 To 0 Step -1 679 If i1 <= iHeaderEnd Then Exit For 'ヘッダーに達した 680 681 If (DeleteText(sOutData(iPageNo).sLineData(i1)) = _ 682 DeleteText(sOutData(iNextPg).sLineData(i2))) _ 683 And Abs(sOutData(iPageNo).iLineDataY(i1) - _ 684 sOutData(iNextPg).iLineDataY(i2)) <= iSa _ 685 Then 686 sOutData(iPageNo).bFooterFlag(i1) = True 687 sOutData(iNextPg).bFooterFlag(i2) = True 688 iFooterEnd = i1 689 If C2_LONG_FT And (i1 > 0) Then 690 '１行上との行間が大きい時は「次は」比較しない。 691 If Abs(sOutData(iPageNo).iLineDataY(i1 - 1) - _ 692 sOutData(iPageNo).iLineDataY(i1)) > _ 693 (sOutData(iPageNo).iAveTextY * C2_LONG_BAI) Then 694 Exit For 695 End If 696 End If 697 End If 698 Next i1 699 End If 700 End If 701 For i1 = 0 To sOutData(iPageNo).iLineCount - 1 702 If sOutData(iPageNo).bFooterFlag(i1) Then 703 iFooterEnd = i1 704 Exit For 705 End If 706 Next i1 707 'フッターの真上の近い行はフッターとして取り込む 708 If C2_SHORT_FT And (iFooterEnd <> -1) Then 709 With sOutData(iPageNo) 710 iSa = .iAveTextY * C2_SHORT_BAI 711 For i1 = iFooterEnd To 1 Step -1 712 If Abs(.iLineDataY(i1) - _ 713 .iLineDataY(i1 - 1)) <= iSa Then 714 .bFooterFlag(i1 - 1) = True 715 .bFooterST(i1 - 1) = True 716 Else 717 Exit For 718 End If 719 Next i1 720 End With 721 End If 722 723 Next_Get_Header_Footer: 724 Next iPageNo 725 726 '■ヘッダー、フッターの数を数える 727 For iPageNo = 0 To UBound(sOutData) 728 With sOutData(iPageNo) 729 .iHeaderCount = 0 730 For i1 = 0 To C_MAXLINE 731 If .bHeaderFlag(i1) Then 732 .iHeaderCount = .iHeaderCount + 1 733 End If 734 Next i1 735 .iFooterCount = 0 736 For i1 = 0 To C_MAXLINE 737 If .bFooterFlag(i1) Then 738 .iFooterCount = .iFooterCount + 1 739 End If 740 Next i1 741 End With 742 Next iPageNo 743 744 End Function 745 746 '************************************************** 747 ' 748 ' ヘッダーとフッターからページ番号と日付に当たる部分を 749 ' 削除する。比較の対象から外すためです。 750 ' 751 ' Create : 2023/03/07 752 ' Update : 2023/03/08 753 ' 754 ' ※[年月日]を入れれば日付を外して比較が出来る 755 '************************************************** 756 Private Function DeleteText( _ 757 ByVal sText As String) As String 758 759 Const D_DATA = "0123456789年月日" & _ 760 "#./*-=+!""$%&'()~|`[]{}@*:;<>?_\/," 761 Dim i1 As Long 762 Dim sW As String 763 Dim iCnt As Long 764 765 '連続する空白は１つにする 766 sText = Replace(sText, " ", " ") 767 sText = Replace(sText, " ", " ") 768 769 For i1 = 1 To Len(D_DATA) 770 sW = Mid$(D_DATA, i1, 1) 771 sText = Replace(sText, sW, "") 772 Next i1 773 774 DeleteText = Trim$(sText) 775 776 End Function 777 778 '************************************************** 779 ' 780 ' 処理結果をテキスト出力する。メモ帳も起動する。 781 ' 782 ' ※デバッグ用ロジック 783 ' 784 ' Create : 2023/03/07 785 ' Update : 2023/03/11 786 ' 787 '************************************************** 788 Private Sub WriteLog( _ 789 ByVal sInFilePathIn As String, _ 790 ByRef sOutData() As PageLineZahyo) 791 792 Dim sLogFilePath As String 793 Dim iFileNo As Long 794 Dim iPageNo As Long 795 Dim i1 As Long 796 Dim i2 As Long 797 Dim iLineC As Long 798 Dim iTextC As Long 799 800 Dim sPage As String 801 Dim iPageL As Long 802 Dim sPrint As String 803 Dim iSeq As Long 804 805 '実行中の当ファイルが格納されたフォルダのパス 806 sLogFilePath = ThisWorkbook.Path & "\" 'Excel 807 iFileNo = FreeFile() 808 sLogFilePath = ThisWorkbook.Path & "\" & "\Log-" & _ 809 Format(Date, "yyyy-mmdd-") & _ 810 Format(Time, "hhmm-ss") & ".txt" 811 Open sLogFilePath For Append As #iFileNo 812 813 '見出し 814 Print #iFileNo, "Log-File = " & sLogFilePath 815 Print #iFileNo, "IN-PDF = " & sInFilePathIn 816 817 'ヘッダー、フッターの一覧 818 For iPageNo = 0 To UBound(sOutData) 819 With sOutData(iPageNo) 820 sPage = "Page=(" & (iPageNo + 1) & "/" & _ 821 (UBound(sOutData) + 1) & ") " 822 iPageL = Len(sPage) 823 'ヘッダー出力 824 iSeq = 1 825 For i2 = 0 To C_MAXLINE 826 If .bHeaderFlag(i2) Then 827 sPrint = sPage & iSeq & _ 828 ".Header(" & .sLineData(i2) & ")" & _ 829 "Y=" & .iLineDataY(i2) 830 Print #iFileNo, sPrint 831 sPage = Space(iPageL) 832 iSeq = iSeq + 1 833 End If 834 Next i2 835 'フッター出力 836 iSeq = 1 837 For i2 = 0 To C_MAXLINE 838 If .bFooterFlag(i2) Then 839 sPrint = sPage & iSeq & _ 840 ".Footer(" & .sLineData(i2) & ")" & _ 841 "Y=" & .iLineDataY(i2) 842 Print #iFileNo, sPrint 843 sPage = Space(iPageL) 844 iSeq = iSeq + 1 845 End If 846 Next i2 847 If Trim(sPage) <> "" Then 848 Print #iFileNo, sPage 849 End If 850 End With 851 Next iPageNo 852 Print #iFileNo, vbCrLf & _ 853 "***************************" & vbCrLf 854 855 '各ページの作業用値の一覧 856 iLineC = 0: iTextC = 0 857 For iPageNo = 0 To UBound(sOutData) 858 With sOutData(iPageNo) 859 Print #iFileNo, _ 860 "Page=(" & (iPageNo + 1) & "/" & _ 861 (UBound(sOutData) + 1) & ")" & _ 862 " 行数=" & .iLineCount & _ 863 " テキスト数=" & .iTextCount & _ 864 " テキスト平均Y高さ=" & .iAveTextY & _ 865 " ヘッダー数=" & .iHeaderCount & _ 866 " フッター数= " & .iFooterCount 867 If (iLineC < .iLineCount) Then iLineC = .iLineCount 868 If (iTextC < .iTextCount) Then iTextC = .iTextCount 869 End With 870 Next iPageNo 871 Print #iFileNo, vbCrLf & "　最大行数=" & _ 872 iLineC & " 最大テキスト数=" & iTextC 873 Print #iFileNo, vbCrLf & "***************************" 874 875 '行データ 876 For iPageNo = 0 To UBound(sOutData) 877 Print #iFileNo, vbCrLf & "=======================" 878 With sOutData(iPageNo) 879 sPage = "Page=(" & (iPageNo + 1) & "/" & _ 880 (UBound(sOutData) + 1) & ") " 881 iPageL = Len(sPage) 882 Print #iFileNo, vbCrLf & sPage & _ 883 " テキスト数=" & .iTextCount & _ 884 " 行数=" & .iLineCount & _ 885 " テキスト平均Y高さ=" & .iAveTextY & _ 886 " ヘッダー数=" & .iHeaderCount & _ 887 " フッター数= " & .iFooterCount 888 sPage = Space(iPageL) 889 iPageL = Len(sPage) 890 891 'ヘッダー出力 892 iSeq = 1 893 For i2 = 0 To C_MAXLINE 894 If .bHeaderFlag(i2) Then 895 sPrint = sPage & iSeq & _ 896 ".Header(" & .sLineData(i2) & ")" & _ 897 "Y=" & .iLineDataY(i2) & _ 898 IIf(.bHeaderST(i2), " S*", "") 899 Print #iFileNo, sPrint 900 sPage = Space(iPageL) 901 iSeq = iSeq + 1 902 End If 903 Next i2 904 905 'フッター出力 906 iSeq = 1 907 For i2 = 0 To C_MAXLINE 908 If .bFooterFlag(i2) Then 909 sPrint = sPage & iSeq & _ 910 ".Footer(" & .sLineData(i2) & ")" & _ 911 "Y=" & .iLineDataY(i2) & _ 912 IIf(.bFooterST(i2), " S*", "") 913 Print #iFileNo, sPrint 914 sPage = Space(iPageL) 915 iSeq = iSeq + 1 916 End If 917 Next i2 918 Print #iFileNo, "" 919 920 'テキスト行 921 For i2 = 0 To .iLineCount - 1 922 Print #iFileNo, "p" & (iPageNo + 1) & " " & _ 923 (i2 + 1) & "/" & .iLineCount & _ 924 " Text=(" & .sLineData(i2) & ")" & _ 925 "Y=" & .iLineDataY(i2) 926 Next i2 927 End With 928 Next iPageNo 929 Print #iFileNo, vbCrLf & "*** EOF ***" 930 Close #iFileNo 931 932 'メモ帳を起動 933 Dim ReturnValue 934 ReturnValue = Shell("NOTEPAD.EXE " & sLogFilePath, 1) 935 End Sub 936 937 '********************************************* 938 ' メモリ上のAcrobatプロセスを数える。 939 '********************************************* 940 Private Function iCheckAcrobat() As Long 941 'On Error GoTo skip_iCheckAcrobat: 'VBA実行時エラー 942 Dim items As Object 943 Set items = CreateObject("WbemScripting.SWbemLocator") _ 944 .ConnectServer.ExecQuery( _ 945 "Select * From Win32_Process " & _ 946 "Where Name = 'Acrobat.exe'") 947 '1以上はプロセス有り、0は無し 948 iCheckAcrobat = items.Count 949 ' Exit Function 950 'skip_iCheckAcrobat: 951 ' miErrorNo = Err.Number 952 ' msErrorMsg = Err.Description 953 End Function 954 955 '********************************************* 956 ' メモリ上に残ったAcrobatプロセスを 957 ' 正常に終了させる為だけの処理です。 958 '********************************************* 959 Sub EndAcrobat() 960 On Error Resume Next 961 Dim objAcroApp As New Acrobat.AcroApp 962 Dim objAcroAVDoc As New Acrobat.AcroAVDoc 963 Dim objAcroPDDoc As New Acrobat.AcroPDDoc 964 Dim objAFormApp As New AFORMAUTLib.AFormApp 965 Dim objAFormField As New AFORMAUTLib.Field 966 Dim objAFormFields As AFORMAUTLib.Fields 967 968 objAcroApp.CloseAllDocs 969 objAcroApp.Hide 970 objAcroApp.Exit 971 972 Set objAFormFields = Nothing 973 Set objAFormField = Nothing 974 Set objAFormApp = Nothing 975 Set objAcroPDDoc = Nothing 976 Set objAcroAVDoc = Nothing 977 Set objAcroApp = Nothing 978 979 '上記の実行後にメモリ上から消える、はず。 980 MsgBox "Acrobat OLEの終了を試みました。" & _ 981 vbCrLf & "10秒後にメモリから消えたのを" & _ 982 vbCrLf & "タスクマネージャーで確認して下さい。", _ 983 vbSystemModal + vbInformation, "お知らせ" 984 End Sub

　　　　

テキストの並び替え関連の定数

テキストをY座標をもとに並び替えます。したくない時は C1_SORTY をFlaseに変更します。行単位（＝座標Yが同じ）でテキストのX座標で並び替えます。したくない時は C1_SORTX をFlaseに変更します。Y座標での並び替えを行うときに、同時にY座標の微妙な誤差（Private Const C1_SA As Long = 3）以内ならば同じ行の先頭のテキストのY座標値に強制的に変更しています。変更したくない時は C1_Y_FIX をFalseに変更します。

Private Const C1_Y_FIX As Boolean = True 'Y座標の修正
Private Const C1_SA As Long = 3 '★差の範囲 Y座標
Private Const C1_SORTX As Boolean = True 'X軸ソートの実行
Private Const C1_SORTY As Boolean = True 'Y軸ソートの実行

ヘッダー、フッター関連の定数

ヘッダーと判断した行の真下（直下）にある行もヘッダーと見なします。したくない場合は以下の C2_SHORT_HD 定数をFalseに変更します。フッターも同様です。フッター行の真上（直上）ある行もヘッダーと見なします。したくない場合はC2_SHORT_FT 定数をFalseにします。
C2_SHORT_BAI 定数は真下、真上と判断する時の計算倍率です。テキストの高さの平均値にこの倍率を掛けて、計算します。この値を大きくすると真下、真上と判断する行が増えます。大きすぎると本文の内容を拾ってしまいます。計算の詳細はVBAソースを御覧ください。

Private Const C2_SHORT_HD As Boolean = True 'ヘッダーの真下
Private Const C2_SHORT_FT As Boolean = True 'フッターの真上
Private Const C2_SHORT_BAI = 1.3 '★行(高さ)の倍率


ヘッダーと判断した行、又はフッターと判断した行と一定以上に離れているテキストは、ヘッダー、又はフッターの判断はしない方がイイです。以下の定数でTrueを設定すると、これが機能します。離れていても判断（チェック）して欲しい時はFalseにします。デフォルトはFalseで、離れていてもヘッダー、フッターの判断をします。
C2_LONG_BAI 定数は離れる行数の最大倍率（２．５行）です。この値を大きくするとチェック対象の行が増えます。

'行間が長い行はチェック対象から外す。
'True：外す　False：外さない
Private Const C2_LONG_HD As Boolean = False 'ヘッダー
Private Const C2_LONG_FT As Boolean = False 'フッター
Private Const C2_LONG_BAI = 2.5 '★行(高さ)の倍率

上記のC2_SHORT_BAI 定数とC2_LONG_BAI 定数は非常に重要です。抽出漏れが有ると感じた時は迷わず値を大きくして見て下さい。

その他の定数

１ページの行数の最大は200（0～200）です。C_MAXLINEで指定してます。行の判断の計算値の分母はC_DEVで４をデフォルトにしています。

Private Const C_MAXLINE As Long = 200 'ページ中の最大行数
Private Const C_DEV As Long = 4 '差計算時の分母

当関数の評価手順

当関数付属の出力テキストファイルでフッターとヘッダーの判断結果を確認します。できるだけ種類の異なるPDFを数種類用意します。

1. 最初は入力PDFを指定するだけで、定数は全てデフォルトにします。
2. 次に以下の定数のTrueをFalseに、FalseをTrueに変更して再実行します。
   Private Const C2_SHORT_HD As Boolean = True
   Private Const C2_SHORT_FT As Boolean = True
   Private Const C2_LONG_HD As Boolean = False
   Private Const C2_LONG_FT As Boolean = False
3. 定数をもとに戻し、以下の値を少しずつ大きくしてみます。
   Private Const C2_SHORT_BAI = 1.3
   Private Const C2_LONG_BAI = 2.5
   C2_LONG_BAI定数はC2_LONG_HDとC2_LONG_FT をTrueにしないと確認できません。
4. 時間があれば、今度は値を小さくしてみます。

出力したテキストファイルはWinMerge 日本語版等でテキスト比較を行うと簡単に違いを確認できます。

備考

下記は処理結果をテキストファイルへ出力する確認用のロジックです。メモ帳も起動します。必要なくなったら、WriteLog 処理も削除して下さい。

Call WriteLog(sInFilePathIn, sOutData)

ヘッダー、フッターに関する情報が不要の方は、OutSquareRects関数内に有る以下の部分を削除して下さい。少しは処理速度が上がります。

bRet = Get_Header_Footer(sOutData)

　　　　

参照

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

その他

• 関数内部にはデバッグ用のロジックも一部残してあります。

　　　

　　　

---

サイト管理者の技術メモ

これ以降はサイト管理者が当ページを管理するための技術メモです。公開用には書いていません。よって、見る必要は無いです。

関数内の数値「－１」の扱い

デバッグ時に使います。未処理だと実行エラーを発生されるようにしています。また、データが存在しなかった時の判断にも利用しています。

「Microsoft Print to PDF」と「Adobe PDF」との違い

MS Office に入っている文書をPDFにする「Microsoft Print to PDF」とAdobe Acrobatに付いている「Adobe PDF」との違いが当関数のテストで分かった。
「Microsoft Print to PDF」で作ったPDFは同じ行でもテキストの座標Yが異なるケースがかなり有る。Y座標値「２」程度だが、当関数でこれを処理すると別の行になってしまいます。「Adobe PDF」で作成したPDFは元の文書が同じ行ならば座標Yは同じになります。画面表示するPDF上のテキストは同じ箇所に有るように見えるが、これをプログラムで扱うとなると別の行の文字列になってしまうのは困る。中心座標Y値が「２」しか違わないのを修正する「座標Y誤差自動修正機能」なるものを追加します。

Y座標誤差自動修正機能

「座標Y軸ソート」をしたときに、直前・直後テキストの前後のY座標の差が有り、その差が２以内の場合は、直前のY座標の値を直後のテキストのY座標に修正する。これが発生した時は再度「座標Y軸ソート」を行う必要が有る。 ＜ー勘違いしてました。再ソートは不要でした。

Y軸ソート時の中心座標Yでの強制修正：Sort_TextData関数内

同じ行の判断は中心座標Yでソートした後にC_DEVの定数を使って判断してします。このソートを行うと座標Yの値によってはテキストが行内の本来の場所とは異なる場所（前後）に入ってしまうケースが出ている。それをカバーする為にソート後に「座標Y誤差の自動修正」ロジックを追加した。座標Yの差が２以下ならば前のテキストの座標Yを直後のテキストの座標Yにセットする。

この後にテキストから行データを作成する処理（関数：MargTextLine）で、前後のテキストの座標Y値がテキストの平均高さの１／４かの判断を行っている。同一行の判断のために。コレはコレで必要な処理、と思う。

微妙な誤差は強制修正が必要だが、ある程度の差は通常の計算値として通常に使用する必要が有る。上記はそうゆう話。

使えない画像

せっかく作ったのに、どこの文章にも使えない画像。

以上。