概要
PDF上のテキストにハイライト表示を追加、削除、変更、一覧の取得ができます。
行がまたがったテキスト（<</Type）も上記のように１つのハイライト表示にできます。VBAからAcrobat OLE経由でAcrobat JavaScriptを実行して処理をします。
座標の取得
ハイライト表示にするテキストの位置は、当サイト公開の関数： GetTextsGetRects「関数：文字列のページ番号と座標を返す」 を使用して取得します。関数で文字列検索をさせ、そのページ番号と座標を取得します。
1. サンプル：ハイライト表示の追加
PDFの指定ページ上の指定テキストをハイライト表示にします。以下は実行するAcrobat JavaScriptです。@ 部分はVBAから変更します。
var annot = this.addAnnot({
type:'Highlight',
quads:[@q],
page:@p,
strokeColor:@c ,
});
- @q：座標（Left , Top , Right , Top , Left , Bottom , Right , Bottom）
「関数：文字列のページ番号と座標を返す」からの座標を使用 - @p：ページ番号、０から開始
- @c：色
- 白： color.white
- 赤： color.red
- 緑： color.green
- 青： color.blue
- シアン： color.cyan
- マゼンタ： color.magenta
- イエロー： color.yellow
- ダークグレー： color.dkGray
- グレー： color.gray
- ライトグレー： color.ltGray
参照設定が２つ必要です。
Download：
/p1105_Annot-Highlight.zip ( 131.8 KB )
001 Option Explicit
002
003 'Debug Mode True：オン False：オフ
004 Private Const DEBUG_MODE As Boolean = False
005
006 '**************************************************
007 '
008 ' PDF上のテキストをハイライト表示にする
009 '
010 ' Create : 2020/06/20
011 ' Update : 2026/03/22
012 ' Vertion : 1.0.4
013 '
014 ' https://pdf-file.nnn2.com/?p=1105
015 '
016 '**************************************************
017
018 Sub sample_Highlight_Add()
019 Dim start As Double: start = Timer
020
021 Dim i1 As Long
022 Dim bRet As Boolean
023 Dim sFilePathIn As String
024 Dim iOutCnt As Long
025 Dim gSerch(19) As type_SerchTexts
026 Dim gRects() As type_TextRect
027
028 Const CON_TEST = 2
029
030 '********************************************
031 '▼ テキストの座標を得る ▼
032 '********************************************
033
034 i1 = 0
035 If CON_TEST = 1 Then
036 gSerch(i1).sSerchText = "ATA": i1 = i1 + 1
037 gSerch(i1).sSerchText = "ス63": i1 = i1 + 1
038 gSerch(i1).sSerchText = "Windows": i1 = i1 + 1
039 gSerch(i1).sSerchText = "Home 64": i1 = i1 + 1
040 gSerch(i1).sSerchText = "10": i1 = i1 + 1
041 gSerch(i1).sSerchText = "8GB": i1 = i1 + 1
042 gSerch(i1).sSerchText = "USB": i1 = i1 + 1
043 gSerch(i1).sSerchText = "HDD": i1 = i1 + 1
044 gSerch(i1).sSerchText = "i5-9400": i1 = i1 + 1
045 gSerch(i1).sSerchText = "RAM": i1 = i1 + 1
046 gSerch(i1).sSerchText = "音電": i1 = i1 + 1
047 gSerch(i1).sSerchText = "6ス": i1 = i1 + 1
048 gSerch(i1).sSerchText = "ル)": i1 = i1 + 1
049 gSerch(i1).sSerchText = "Adobe": i1 = i1 + 1
050 gSerch(i1).sSerchText = "Acrobat": i1 = i1 + 1
051 gSerch(i1).sSerchText = "JavaScript": i1 = i1 + 1
052 gSerch(i1).sSerchText = "Get": i1 = i1 + 1
053 gSerch(i1).sSerchText = "getPage": i1 = i1 + 1
054 gSerch(i1).sSerchText = "Common Dialog Control": i1 = i1 + 1
055 gSerch(i1).sSerchText = "Text""annot": i1 = i1 + 1
056 sFilePathIn = ThisWorkbook.Path & "\test-002.pdf"
057 Else
058 gSerch(i1).sSerchText = "文目": i1 = i1 + 1
059 gSerch(i1).sSerchText = "ビューア": i1 = i1 + 1
060 gSerch(i1).sSerchText = "文字や図形や画像": i1 = i1 + 1
061 gSerch(i1).sSerchText = "Acrobat Reader": i1 = i1 + 1
062 gSerch(i1).sSerchText = "テキスト": i1 = i1 + 1
063 gSerch(i1).sSerchText = "構成する様々な要素": i1 = i1 + 1
064 gSerch(i1).sSerchText = "%PDF-1.2": i1 = i1 + 1
065 gSerch(i1).sSerchText = "Acrobat": i1 = i1 + 1
066 gSerch(i1).sSerchText = "がPDF": i1 = i1 + 1
067 gSerch(i1).sSerchText = "<</Type": i1 = i1 + 1
068 'gSerch(i1).sSerchText = "<< /Type": i1 = i1 + 1
069 sFilePathIn = ThisWorkbook.Path & "\手書きPDF入門-4.pdf"
070 End If
071
072 'PDF上をテキスト検索し、そのページ番号と座標を取得
073 'URL： https://pdf-file.nnn2.com/?p=1099
074 bRet = GetTextsGetRects(sFilePathIn, -1, -1, _
075 gSerch, gRects, iOutCnt)
076
077 '********************************************
078 '▼ ハイライト表示にする ▼
079 '********************************************
080
081 Dim sWkCon As String
082 Dim sQuads As String
083 Dim i2 As Long
084 Dim sAJS As String
085 Dim sReturn As String
086 Dim objAcroApp As New Acrobat.AcroApp
087 Dim objAcroAVDoc As New Acrobat.AcroAVDoc
088 Dim objAcroPDDoc As New Acrobat.AcroPDDoc
089 Dim objAcroPDPage As Acrobat.AcroPDPage
090 Dim objAcroAVPageView As Acrobat.AcroAVPageView
091 Dim objAFormApp As New AFORMAUTLib.AFormApp
092 Dim objAFormFields As AFORMAUTLib.Fields
093
094 objAcroApp.CloseAllDocs
095 objAcroApp.Hide '稀にデスクトップに表示されるので隠す
096 'PDFファイルを開く
097 bRet = objAcroAVDoc.Open(sFilePathIn, "")
098 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
099 ' Set objAFormApp = CreateObject("AFormAut.App")
100 Set objAFormFields = objAFormApp.Fields
101
102 Const sAcrobatJavaScript3 = _
103 "oRet = this.addAnnot({" & _
104 " type:'Highlight' ," & _
105 " quads:[@q] ," & _
106 " page:@p ," & _
107 " strokeColor:@c ," & _
108 "}); "
109 ' " contents:'@t', " & _
110 ' " author:'@A' ," & _
111
112 If DEBUG_MODE Then
113 Call Put_Degug_log("")
114 For i1 = 0 To iOutCnt
115 With gRects(i1)
116 If .iSearchNo = -1 Then Exit For
117 Call Put_Degug_log( _
118 "Text(" & i1 & ")=[" & _
119 gSerch(.iSearchNo).sSerchText & _
120 "] SIndex=" & .iSearchNo & _
121 " Page=" & .iPageNo & _
122 " Quads=" & .sQuads)
123 End With
124 Next i1
125 End If
126
127 For i1 = 0 To iOutCnt
128 With gRects(i1)
129 sWkCon = "Text=[" & _
130 Replace(gSerch(.iSearchNo).sSerchText, "'", "''") & _
131 "] " & _
132 " Quads=" & .sQuads
133 sAJS = sAcrobatJavaScript3
134 sAJS = Replace(sAJS, "@q", EditQuads_8item(.sQuads))
135 sAJS = Replace(sAJS, "@c", "color.yellow")
136 sAJS = Replace(sAJS, "@p", .iPageNo)
137 ' sAJS = Replace(sAJS, "@t", sWkCon)
138 End With
139 '■Acrobat JavaScript の実行
140 sReturn = objAFormFields.ExecuteThisJavascript(sAJS)
141 Next i1
142
143 'PDFファイルを別名で保存
144 Dim sFilePathOut As String
145 sFilePathOut = Replace(sFilePathIn, ".pdf", "-Add_Highlight.pdf")
146 If objAcroPDDoc.Save(1, sFilePathOut) = False Then
147 MsgBox "PDFファイルへ保存出来ませんでした", _
148 vbOKOnly + vbCritical, "実行エラー"
149 End If
150 '変更しないで閉じます。
151 bRet = objAcroAVDoc.Close(False)
152 'Acrobatアプリケーションの終了
153 objAcroApp.Hide
154 objAcroApp.Exit
155 'オブジェクトの開放
156 Set objAcroAVPageView = Nothing
157 Set objAcroPDPage = Nothing
158 Set objAcroAVDoc = Nothing
159 Set objAFormApp = Nothing
160 Set objAFormFields = Nothing
161 Set objAcroApp = Nothing
162
163 Debug.Print "Output Count = " & iOutCnt
164 Debug.Print "Total Time = " & Timer - start
165
166 If DEBUG_MODE Then Call Run_NOTEPAD
167 End Sub
168
169 '**************************************************
170 '
171 ' Quads値を８値で１組に変換する
172 '
173 ' Create : 2020/06/08
174 ' Version: 1.0.0
175 '
176 ' 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15 ->
177 ' [1,2,3,4,5,6,7,8],[9,10,11,12,13,14,15]
178 '
179 '**************************************************
180 Private Function EditQuads_8item(ByVal sQuads As String)
181 Dim sWk() As String
182 Dim sQ As String
183 Dim i1 As Long
184 EditQuads_8item = ""
185 sWk = Split(sQuads, ",")
186 For i1 = 0 To UBound(sWk) Step 8
187 sQ = "[" & sWk(i1 + 0) & ","
188 sQ = sQ + sWk(i1 + 1) & ","
189 sQ = sQ + sWk(i1 + 2) & ","
190 sQ = sQ + sWk(i1 + 3) & ","
191 sQ = sQ + sWk(i1 + 4) & ","
192 sQ = sQ + sWk(i1 + 5) & ","
193 sQ = sQ + sWk(i1 + 6) & ","
194 sQ = sQ + sWk(i1 + 7) & "]"
195 If EditQuads_8item <> "" Then _
196 EditQuads_8item = EditQuads_8item & ","
197 EditQuads_8item = EditQuads_8item & sQ
198 Next i1
199 End Function
1.1 実行結果
実行前です。
実行後です。
2. サンプル：ハイライト表示の削除
ハイライト表示になっているのを解除します。テキストの削除はしません。以下は実行するAcrobat JavaScriptです。@ 部分はVBAから変更します。
var annots = this.getAnnots({ nPage:@p });
for (var i = 0; i < annots.length; i++)
if (annots[i].type == "Highlight")
annots[i].destroy();
- @p：ページ番号、０から開始
参照設定が２つ必要です。
Download： /p1105_Annot-Highlight.zip ( 131.8 KB )
001 Option Explicit
002
003 '**************************************************
004 '
005 ' PDFのハイライト表示の注釈を削除
006 '
007 ' Create : 2020/04/11
008 ' Update : 2026/03/22
009 ' Vertion : 1.0.1
010 '
011 '**************************************************
012
013 Private Sub sample_Highlight_Delete()
014
015 Dim start As Double: start = Timer
016
017 Dim objAcroApp As New Acrobat.AcroApp
018 Dim objAcroAVDoc As New Acrobat.AcroAVDoc
019 Dim objAcroPDDoc As New Acrobat.AcroPDDoc
020 Dim objAcroPDPage As Acrobat.AcroPDPage
021 Dim objAcroAVPageView As Acrobat.AcroAVPageView
022 Dim objAFormApp As New AFORMAUTLib.AFormApp
023 Dim objAFormFields As AFORMAUTLib.Fields
024
025 Dim iPageNo As Long
026 Dim iPageCnt As Long
027 Dim iRet As Long
028 Dim bRet As Boolean
029 Dim sFilePathIn As String
030 Dim sAJS As String
031 Dim sJsRet As String
032
033 'ページ単位でのハイライト表示の注釈を削除
034 Const sAcrobatJavaScript1 = _
035 "var annots = this.getAnnots({ nPage:@p });" & _
036 "for (var i = 0; i < annots.length; i++) " & _
037 "if (annots[i].type == 'Highlight') " & _
038 " annots[i].destroy();" & _
039 "event.value=i;"
040
041 '全ページのハイライト表示の注釈を削除
042 Const sAcrobatJavaScript2 = _
043 "var annots = this.getAnnots({ });" & _
044 "for (var i = 0; i < annots.length; i++)" & _
045 "if (annots[i].type == 'Highlight') " & _
046 " annots[i].destroy();" & _
047 "event.value=i;"
048
049 sFilePathIn = ThisWorkbook.Path & "\test-004-New.pdf"
050 ' sFilePathIn = ThisWorkbook.Path & "\手書きPDF入門-4.pdf"
051
052 objAcroApp.CloseAllDocs
053 objAcroApp.Hide '稀にデスクトップに表示されるので隠す
054 'PDFファイルを開く
055 bRet = objAcroAVDoc.Open(sFilePathIn, "")
056 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
057 iPageCnt = objAcroPDDoc.GetNumPages
058
059 ' Set objAFormApp = CreateObject("AFormAut.App")
060 Set objAFormFields = objAFormApp.Fields
061 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
062
063 Const CON_TEST = 2
064
065 If CON_TEST = 1 Then
066 'ページ単位での削除
067
068 For iPageNo = 0 To iPageCnt - 1
069 'Acrobat JavaScriptの編集
070 sAJS = sAcrobatJavaScript1
071 sAJS = Replace(sAJS, "@p", iPageNo)
072 'Acrobat JavaScript の実行
073 sJsRet = objAFormFields.ExecuteThisJavascript(sAJS)
074
075 Debug.Print "Page=" & iPageNo + 1 & _
076 " Delete=" & sJsRet
077 Next iPageNo
078 Else
079 '全ページでの削除
080
081 'Acrobat JavaScriptの編集
082 sAJS = sAcrobatJavaScript2
083 'Acrobat JavaScript の実行
084 sJsRet = objAFormFields.ExecuteThisJavascript(sAJS)
085
086 Debug.Print "Page=All Delete=" & sJsRet
087 End If
088
089 'PDFファイルを別名で保存
090 Dim sFilePathOut As String
091 sFilePathOut = Replace(sFilePathIn, _
092 ".pdf", "-Dele_Highlight.pdf")
093 If objAcroPDDoc.Save(1, sFilePathOut) = False Then
094 MsgBox "PDFファイルへ保存出来ませんでした", _
095 vbOKOnly + vbCritical, "実行エラー"
096 End If
097 '変更しないで閉じます。
098 bRet = objAcroAVDoc.Close(False)
099 'Acrobatアプリケーションの終了
100 objAcroApp.Hide
101 objAcroApp.Exit
102 'オブジェクトの開放
103 Set objAcroAVPageView = Nothing
104 Set objAFormFields = Nothing
105 Set objAcroPDPage = Nothing
106 Set objAcroPDDoc = Nothing
107 Set objAcroAVDoc = Nothing
108 Set objAcroApp = Nothing
109
110 Debug.Print "Total Time = " & Timer - start
111 End Sub
2.1 実行結果
実行前です。
実行後です。
3. サンプル：ハイライト表示の色を変更
ハイライト表示の色を変更します。黄色（color.yellow）から緑（color.green）に変更します。
以下は実行するAcrobat JavaScriptです。@ 部分はVBAから変更します。
var annots = this.getAnnots({ nPage:@p });
for (var i = 0; i < annots.length; i++)
if (annots[i].type == "Highlight")
annots[i].strokeColor = @c;
- @p：ページ番号、０から開始
- @c：ハイライトの色
- 白： color.white
- 赤： color.red
- 緑： color.green
- 青： color.blue
- シアン： color.cyan
- マゼンタ： color.magenta
- イエロー： color.yellow
- ダークグレー： color.dkGray
- グレー： color.gray
- ライトグレー： color.ltGray
参照設定が２つ必要です。
Download： /p1105_Annot-Highlight.zip ( 131.8 KB )
001 Option Explicit
002
003 '**************************************************
004 '
005 ' PDFのハイライト表示の注釈の色を変更
006 '
007 ' Create : 2020/04/11
008 ' Update : 2026/03/22
009 ' Vertion : 1.0.2
010 '
011 ' Acrobat JavaScriptのカラー定数
012 ' 白: color.white
013 ' 赤: color.red
014 ' 緑: color.green
015 ' 青: color.blue
016 ' シアン: color.cyan
017 ' マゼンタ: color.magenta
018 ' イエロー: color.yellow
019 ' ダークグレー: color.dkGray
020 ' グレー: color.Gray
021 ' ライトグレー: color.ltGray
022 '
023 '**************************************************
024
025 Private Sub sample_Highlight_Update()
026
027 Dim start As Double: start = Timer
028
029 Dim objAcroApp As New Acrobat.AcroApp
030 Dim objAcroAVDoc As New Acrobat.AcroAVDoc
031 Dim objAcroPDDoc As New Acrobat.AcroPDDoc
032 Dim objAcroPDPage As Acrobat.AcroPDPage
033 Dim objAcroAVPageView As Acrobat.AcroAVPageView
034 Dim objAFormApp As New AFORMAUTLib.AFormApp
035 Dim objAFormFields As AFORMAUTLib.Fields
036
037 Dim iPageNo As Long
038 Dim iPageCnt As Long
039 Dim iRet As Long
040 Dim bRet As Boolean
041 Dim sFilePathIn As String
042 Dim sAJS As String
043 Dim sJsRet As String
044
045 'ページ単位でのハイライト表示の注釈の色を変更
046 Const sAcrobatJavaScript1 = _
047 "var annots = this.getAnnots({ nPage:@p });" & _
048 "for (var i = 0; i < annots.length; i++)" & _
049 "if (annots[i].type == 'Highlight') " & _
050 " annots[i].strokeColor = @c;" & _
051 "event.value=i;"
052
053 '全ページのハイライト表示の注釈の色を変更
054 Const sAcrobatJavaScript2 = _
055 "var annots = this.getAnnots({ });" & _
056 "for (var i = 0; i < annots.length; i++)" & _
057 "if (annots[i].type == 'Highlight') " & _
058 " annots[i].strokeColor = @c;" & _
059 "event.value=i;"
060
061 sFilePathIn = ThisWorkbook.Path & "\test-004-New.pdf"
062 ' sFilePathIn = ThisWorkbook.Path & "\手書きPDF入門-4.pdf"
063
064 objAcroApp.CloseAllDocs
065 objAcroApp.Hide '稀にデスクトップに表示されるので隠す
066
067 'PDFファイルを開く
068 bRet = objAcroAVDoc.Open(sFilePathIn, "")
069 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
070 iPageCnt = objAcroPDDoc.GetNumPages
071
072 ' Set objAFormApp = CreateObject("AFormAut.App")
073 Set objAFormFields = objAFormApp.Fields
074 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
075
076 Const CON_TEST = 1
077
078 If CON_TEST = 1 Then
079 'ページ単位での変更
080
081 For iPageNo = 0 To iPageCnt - 1
082 'Acrobat JavaScriptの編集
083 sAJS = sAcrobatJavaScript1
084 sAJS = Replace(sAJS, "@p", iPageNo)
085 sAJS = Replace(sAJS, "@c", "color.green")
086 'Acrobat JavaScript の実行
087 sJsRet = objAFormFields.ExecuteThisJavascript(sAJS)
088
089 Debug.Print "Page=" & iPageNo + 1 & _
090 " Update=" & sJsRet
091 Next iPageNo
092 Else
093 '全ページでの変更
094
095 'Acrobat JavaScriptの編集
096 sAJS = sAcrobatJavaScript2
097 sAJS = Replace(sAJS, "@c", "color.green")
098 'Acrobat JavaScript の実行
099 sJsRet = objAFormFields.ExecuteThisJavascript(sAJS)
100
101 Debug.Print "Page=All Update=" & sJsRet
102 End If
103
104 'PDFファイルを別名で保存
105 Dim sFilePathOut As String
106 sFilePathOut = Replace(sFilePathIn, ".pdf", _
107 "-Update_Highlight.pdf")
108 If objAcroPDDoc.Save(1, sFilePathOut) = False Then
109 MsgBox "PDFファイルへ保存出来ませんでした", _
110 vbOKOnly + vbCritical, "実行エラー"
111 End If
112 '変更しないで閉じます。
113 bRet = objAcroAVDoc.Close(False)
114 'Acrobatアプリケーションの終了
115 objAcroApp.Hide
116 objAcroApp.Exit
117 'オブジェクトの開放
118 Set objAcroAVPageView = Nothing
119 Set objAFormFields = Nothing
120 Set objAcroPDPage = Nothing
121 Set objAcroPDDoc = Nothing
122 Set objAcroAVDoc = Nothing
123 Set objAcroApp = Nothing
124
125 Debug.Print "Total Time = " & Timer - start
126 End Sub
3.1 実行結果
実行前です。
実行後です。
4. サンプル：ハイライト表示の一覧
ハイライト表示になっている箇所の
- ページ番号
- 座標：Left , Right , Top , Bottom
を取得します。
参照設定が２つ必要です。
Download： /p1105_Annot-Highlight.zip ( 131.8 KB )
001 Option Explicit
002
003 '**************************************************
004 '
005 ' PDFのハイライト表示の一覧を取得
006 '
007 ' Create : 2020/04/11
008 ' Update : 2026/03/22
009 ' Vertion : 1.0.2
010 '
011 '**************************************************
012
013 'ハイライトテキストの最大数
014 Private Const MAX_GetText As Long = 32767
015
016 Private Type typeListFromRect
017 iPageNo As Long '検索ページ番号
018 sQuads As String 'quads値
019 iSeq As Long 'SeqNo
020 sColor As String '色
021 sText As String 'Text デバッグ用
022 End Type
023
024 '※ 0[Left] 1[Top] 2[Right] 3[Top]
025 '※ 4[Left] 5[Bottom] 6[Right] 7[Bottom]
026
027 Private Sub sample_Highlight_List()
028
029 Dim start As Double: start = Timer
030
031 Dim objAcroApp As New Acrobat.AcroApp
032 Dim objAcroAVDoc As New Acrobat.AcroAVDoc
033 Dim objAcroPDDoc As New Acrobat.AcroPDDoc
034 Dim objAcroPDPage As Acrobat.AcroPDPage
035 Dim objAcroAVPageView As Acrobat.AcroAVPageView
036 Dim objAFormApp As New AFORMAUTLib.AFormApp
037 Dim objAFormFields As AFORMAUTLib.Fields
038
039 Dim iPageNo As Long
040 Dim iPageCnt As Long
041 Dim iRet As Long
042 Dim bRet As Boolean
043 Dim sFilePathIn As String
044
045 'ページ単位でのハイライト表示の一覧
046 Const sAcrobatJavaScript1 = _
047 "var sout='';" & _
048 "var annots = this.getAnnots({ nPage:@p , nSortBy: ANSB_Page });" & _
049 "for (var i = 0; i < annots.length; i++)" & _
050 "if (annots[i].type == 'Highlight') " & _
051 "sout=sout + annots[i].page + '\t' + i + '\t' + " & _
052 "annots[i].strokeColor + '\t' + annots[i].quads + '\b';" & _
053 "event.value=sout;"
054 '※特殊文字「\b：バックスペース」「\t：タブ」データの区切り
055
056 '全ページのハイライト表示の一覧
057 Const sAcrobatJavaScript2 = _
058 "var sout='';" & _
059 "var annots = this.getAnnots({ nSortBy: ANSB_Page });" & _
060 "for (var i = 0; i < annots.length; i++)" & _
061 "if (annots[i].type == 'Highlight') " & _
062 "sout=sout + annots[i].page + '\t' + i + '\t' + " & _
063 "annots[i].strokeColor + '\t' + annots[i].quads + '\b';" & _
064 "event.value=sout;"
065 'nSortBy: ANSB_Page ページ番号でソート
066
067 sFilePathIn = ThisWorkbook.Path & "\test-002-Add_Highlight.pdf"
068 ' sFilePathIn = ThisWorkbook.Path & "\手書きPDF入門-4-Add_Highlight.pdf"
069
070 objAcroApp.CloseAllDocs
071 objAcroApp.Hide '稀にデスクトップに表示されるので隠す
072
073 'PDFファイルを開く
074 bRet = objAcroAVDoc.Open(sFilePathIn, "")
075 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
076 iPageCnt = objAcroPDDoc.GetNumPages
077
078 ' Set objAFormApp = CreateObject("AFormAut.App")
079 Set objAFormFields = objAFormApp.Fields
080 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
081
082 Dim sAJS As String
083 Dim sJsRet As String
084 Dim i1 As Long
085 Dim i2 As Long
086 Dim i3 As Long
087 Dim i4 As Long
088 Dim sAjWk1() As String
089 Dim sAjWk2() As String
090 Dim sAjWk3() As String
091 Dim sAjWk4 As String
092 Dim sOutText(MAX_GetText) As String
093 Dim ListZahyo(MAX_GetText) As typeListFromRect
094 Dim FindTextFR(MAX_GetText) As typeFindTextFromRect
095
096 Erase ListZahyo
097 Erase FindTextFR
098
099 Const CON_SEQ = False 'True：SEQを表示 False：非表示
100 Const CON_TEST = 2 'テストケース
101
102 If CON_TEST = 1 Then
103 'ページ単位での一覧
104 For iPageNo = 0 To iPageCnt - 1
105 i4 = 0
106
107 'Acrobat JavaScriptの編集
108 sAJS = sAcrobatJavaScript1
109 sAJS = Replace(sAJS, "@p", iPageNo)
110 'Acrobat JavaScript の実行
111
112 bRet = objAcroAVDoc.Open(sFilePathIn, "")
113 ' Set objAFormApp = CreateObject("AFormAut.App")
114 Set objAFormFields = objAFormApp.Fields
115 Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
116
117 sJsRet = objAFormFields.ExecuteThisJavascript(sAJS)
118
119 '結果を編集
120 Erase ListZahyo
121 Erase FindTextFR
122 sAjWk1 = Split(sJsRet, vbBack)
123 For i1 = 0 To UBound(sAjWk1)
124 If sAjWk1(i1) = "" Then Exit For
125 sAjWk2 = Split(sAjWk1(i1), vbTab)
126
127 '結果を出力
128 With ListZahyo(i4)
129 .iSeq = sAjWk2(1)
130 .sColor = sAjWk2(2)
131 .sText = ""
132 End With
133 With FindTextFR(i4)
134 .iPageNo = iPageNo
135 .sQuads = sAjWk2(3)
136 .sText = ""
137 End With
138 i4 = i4 + 1
139 Next i1
140
141 '座標からテキストを抽出
142 bRet = GetTextsFromRect(sFilePathIn, _
143 iPageNo + 1, iPageNo + 1, FindTextFR, sOutText)
144
145 '結果を出力
146 For i1 = 0 To UBound(sAjWk1)
147 If sAjWk1(i1) = "" Then Exit For
148 With FindTextFR(i1)
149 Call Put_Degug_log( _
150 "Page=" & iPageNo & _
151 IIf(CON_SEQ, " Seq=" & ListZahyo(i1).iSeq, "") & _
152 " Color=" & ListZahyo(i1).sColor & _
153 " Quads=[" & .sQuads & _
154 "] (" & sOutText(i1) & ")")
155 End With
156 Next i1
157 Call Put_Degug_log("")
158
159 Erase ListZahyo
160 Erase FindTextFR
161 Next iPageNo
162 Else
163 '全ページでの一覧
164
165 'Acrobat JavaScriptの編集
166 sAJS = sAcrobatJavaScript2
167 'Acrobat JavaScript の実行
168 sJsRet = objAFormFields.ExecuteThisJavascript(sAJS)
169
170 i4 = 0
171 '結果を編集
172 sAjWk1 = Split(sJsRet, vbBack)
173 For i1 = 0 To UBound(sAjWk1)
174 If sAjWk1(i1) = "" Then Exit For
175 sAjWk2 = Split(sAjWk1(i1), vbTab)
176 '結果を出力
177 With ListZahyo(i4)
178 .iSeq = sAjWk2(1)
179 .sColor = sAjWk2(2)
180 .sText = ""
181 End With
182 With FindTextFR(i4)
183 .iPageNo = sAjWk2(0)
184 .sQuads = sAjWk2(3)
185 .sText = ""
186 End With
187 i4 = i4 + 1
188 Next i1
189
190 '座標からテキストを抽出
191 bRet = GetTextsFromRect(sFilePathIn, _
192 -1, -1, FindTextFR, sOutText)
193
194 '結果を出力
195 For i1 = 0 To UBound(sAjWk1)
196 If sAjWk1(i1) = "" Then Exit For
197 With FindTextFR(i1)
198 Call Put_Degug_log( _
199 "Page=" & .iPageNo & _
200 IIf(CON_SEQ, " Seq=" & ListZahyo(i1).iSeq, "") & _
201 " Color=" & ListZahyo(i1).sColor & _
202 " Quads=[" & .sQuads & _
203 "] (" & sOutText(i1) & ")")
204 End With
205 If i1 < UBound(sAjWk1) Then
206 If FindTextFR(i1).iPageNo <> FindTextFR(i1 + 1).iPageNo Then
207 Call Put_Degug_log("")
208 End If
209 End If
210 Next i1
211
212 End If
213
214 '変更しないで閉じます。
215 bRet = objAcroAVDoc.Close(False)
216 'Acrobatアプリケーションの終了
217 objAcroApp.Hide
218 objAcroApp.Exit
219 'オブジェクトの開放
220 Set objAcroAVPageView = Nothing
221 Set objAFormFields = Nothing
222 Set objAcroPDPage = Nothing
223 Set objAcroPDDoc = Nothing
224 Set objAcroAVDoc = Nothing
225 Set objAcroApp = Nothing
226
227 Call Run_NOTEPAD
228
229 Debug.Print "Total Time = " & Timer - start
230 End Sub
4.1 実行結果
結果はDebug.printでイミディエイト画面上に表示されます。
複数の行（列）にまたがったハイライトの座標 quads は 8 x n個の表示になります。
Page=0 seq=3 color=CMYK,0,0,1,0 quads=515.9249877929688,254.5070037841797,554.4559936523438,254.5070037841797,515.9249877929688,244.94500732421875,554.4559936523438,244.94500732421875,74.52000427246094,240.10699462890625,113.00399780273438,240.10699462890625,74.52000427246094,230.5449981689453,113.00399780273438,230.5449981689453
上記はカンマの区切りでquadsに16個の数値が存在します。
quadsプロパティのパラメータ
ハイライト表示で重要なquadsプロパティのパラメータ。各値が座標上のどの位置を示すか図で出してみました。
▼座標が１つの場合
quads: [[
Left ,Top,
Right,Top,
Left ,Bottom,
Right,Bottom
]],
▼座標が２つにまたがる場合
quads: [[
Left ,Top,
Right,Top,
Left ,Bottom,
Right,Bottom
] , [
Left ,Top,
Right,Top,
Left ,Bottom,
Right,Bottom
]],
３つ以上になると quads [ [ ] , [ ] , [ ] , ・・・] となります。１つの [ ] で１つの四角を示します。
Acrobat JavaScript
各命令（メソッド、プロパティ）の説明は省略します。サンプルをそのままご使用ください。
詳細を知りたい方は、公開マニュアル「JavaScript™ for Acrobat® API Reference Adobe® Acrobat® SDK バージョン 8.0」を御覧ください。
注意
- Acrobat JavaScript でハイライト表示の座標の指定には「quads」を使用してください。「rect」を使った説明が公式解説書にもネット情報にも存在しますが、実際は正常に機能しません。
- Acrobat JavaScriptの日本語版の解説書は上記以降は英語版しか存在しません。機能的なUpdateも殆ど無いので最新バージョンのAcrobatに相当するマニュアルも存在しません。それが現実です。
テキストの抽出は無理
一覧にハイライト表示の対象になっているテキストも抽出できたらイイのですが、これは少し無理が有ります。文字の幅が同じの等幅フォントなら計算でピッタシと出すことは出来ます。
しかし今はプロポーショナルフォント (又は可変幅フォント)を使うのが一般的で、そうなると文字幅が変化します。それを正確に計算で出すのは技術的に（今の私には）無理です。
※それでも要望が有れば、作ります！
テキスト上でなくても構わない
ハイライトは基本的にテキスト（文字列）の上に追加します。Acrobat又はAcrobat Readerでテキストを選択した状態でしか、ハイライト操作はできません。しかし、実際はどこでも出来ます。
上記はAcrobat JavaScriptで追加したハイライトです。
備考
- 特になし。
参照
- Acrobat JavaScript：
Adobe® Acrobat® SDK バージョン 8.0 日本語の解説書- addAnnot
Annotation オブジェクト（注釈）を作成。 - Type
注釈のタイプ（種類） - quads
n 個の四角形の座標。8 × n の数値配列。 - getPageNthWordQuads
ページ上の n 番目の単語の quads のリストを取得 - strokeColor
描くときの色を指定
- addAnnot
サイト管理人の技術メモ
これ以降はサイト管理者が当サイト又は当ページを維持＆管理するためのメモです。見る必要も無く公開用にも書いてません。
rectプロパティを使用すると
座標の取得はquadsプロパティを使います。rectプロパティを使うと元より２ポイントほど大きめの座標が取得されてしまいます。以下は「ATA」テキスト上のハイライト表示の座標を使用した結果です。
下のrect プロパティで取得した座標で再度ハイライト表示を行うと前の「S」文字まで入ってしまいます。
またrectプロパティでは複数（行、列）の座標は取得できません。
サンプル：ハイライト表示の追加
quadsで四角形の座標を２つ同時に指定している部分に注目。
2つ指定の情報はネットに無く、テスト結果から出しました。
var annot = this.addAnnot({
type: "Highlight",
quads: [[107.16175842285156 , 604.546630859375 , 126.39341735839844 , 604.546630859375 , 107.16175842285156 , 594.9851684570312 , 126.39341735839844 , 594.9851684570312 ] , [74.52000427246094 , 590.1466674804688 , 97.49845886230469 , 590.1466674804688 , 74.52000427246094 , 580.585205078125 , 97.49845886230469 , 580.585205078125]] ,
page: 0,
strokeColor: color.yellow,
});
サンプル：ページ 0 の「Highlight」注釈の座標を表示
var annots = this.getAnnots({ nPage:0 });
for (var i = 0; i < annots.length; i++)
if (annots[i].type == "Highlight")
console.println( annots[i].quads + '\n');
複数行にまたがるハイライト表示は「８ x 複数行」の数値がカンマ「,」区切りで標示される。「[」は表示されません。
以上。