Wordのページ数の取得

質問

お世話になります。
前回、「Word, Excel, PowerPointで2バイト文字検索」質問させていただいた者です。
http://oshiete1.goo.ne.jp/kotaeru.php3?q=1269218

2バイト文字の検索のコアな部分は出来ているのですが、検索が見つかった場合そのページにジャンプさせることが上手く出来ません。
ページをジャンプさせる方法その物は分かったのですが、オブジェクトからページ番号を取得する方法が分かりません。

テキストは以下のように取得しています（i,jはそれぞれ.count分ループ）。
Application.Documents.Item(i).Words(j).Text
Application.Documents.Item(i).Shapes.Item(j).TextFrame.TextRange.Text

下記のオブジェクトからページ番号を取得する方法はございますでしょうか。
Application.Documents.Item(i).Words(j)
Application.Documents.Item(i).Shapes.Item(j).TextFrame.TextRange

または、逆にページ単位で処理を行い、ページ内にあるオブジェクトを取得する方法はございますでしょうか。

代替の方法がございましたらそちらでも構いません。
以上、宜しくお願い致します。

回答No.1

Wendy02 · ベストアンサー

＞下記のオブジェクトからページ番号を取得する方法はございますでしょうか。
＞Application.Documents.Item(i).Words(j)
＞Application.Documents.Item(i).Shapes.Item(j).TextFrame.TextRange

http://oshiete1.goo.ne.jp/kotaeru.php3?q=1269218
そこからは、ページを取ることは不可能だと思います。Word の質問の回答では、みなさん、同じパターンになるようです。（某掲示板にも遣り残しがありました）それは、Text の入れ物であって、その先があります。
私のやり方は、正規表現を使います。最初に、文字列を確保していき、その後で、それを置換でハイライト化していく方法を取ります。

それで、最初、Findメソッドを使うのですが、Excelよりも、何かを付け忘れたりすると、失敗することがあるので、一応、全部、オプションはつけて置きました。
また、今回、正規表現を使っていますが、全ての２バイト文字をサポートしているわけではありませんので、パターンの部分を、その文字の領域に従って書き換えてください。InStr で、取る方法もあるのですが、私は、正規表現のほうがなじみが深いのです。

ここのサイトは、単発回答がほとんどで、もし、何かありましても、私がフィードバックできないことがあるかもしれませんので、あらかじめ、お詫びしておきます。

Option Explicit
Sub TwoByteStrFindProc()
'参照設定 Microsoft VBScript Regular Expressions 5.5
Dim objRegExp As New RegExp
Dim mySelection As Selection
Dim Matches As Object
Dim Match
Dim TowByte()
Dim sLength As Long
Dim i As Long
Options.DefaultHighlightColorIndex = wdTurquoise
Selection.HomeKey Unit:=wdStory
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Set mySelection = Selection
　　With objRegExp
　　　　.Global = True
　　　　.IgnoreCase = True
　　　　.Pattern = "[\u3041-\u30FA\u4E00-\u9FA5\uff01-\uff9f]+"
　　　　Set Matches = .Execute(mySelection)
　　　　sLength = 0
　　End With
　　For Each Match In Matches
　　　　　　 ReDim Preserve TowByte(i)
　　　　　　 TowByte(i) = Match.Value
　　　　　　 i = i + 1
　　Next Match
　　If Matches.Count = 0 Then MsgBox _
　　"該当する検索文字が見つかりません", 64: Exit Sub
　　For i = 0 To UBound(TowByte)
　　　WordHilightProc TowByte(i)
　　Next
　　Options.DefaultHighlightColorIndex = wdNoHighlight
End Sub
Private Sub WordHilightProc(ByVal myStr As String)
　Dim myRange As Range
　Selection.Find.ClearFormatting
　With Selection.Find
　　.Text = myStr
　　.Replacement.Text = ""
　　.Forward = True
　　.Wrap = wdFindContinue
　　.Format = False
　　.MatchCase = False
　　.MatchWholeWord = False
　　.MatchByte = False
　　.MatchAllWordForms = False
　　.MatchSoundsLike = False
　　.MatchWildcards = False
　　.MatchFuzzy = False
　End With
　With Selection
　　 .Find.ClearFormatting
　　 .Find.Replacement.ClearFormatting
　　 .Find.Replacement.Highlight = True
　　If .Find.Forward = True Then
　　　.Collapse Direction:=wdCollapseStart
　　　Else
　　　.Collapse Direction:=wdCollapseEnd
　　End If
　　.Find.Execute Replace:=wdReplaceOne
　　If .Find.Forward = True Then
　　　.Collapse Direction:=wdCollapseEnd
　　　Else
　　　.Collapse Direction:=wdCollapseStart
　　End If
　　.Find.Execute
　End With
End Sub

お礼

返事が遅くなってしまい申し訳ございません。
頂いたソースコードを実際に実行して見たのですが、現在の正規表現ではやはり漏れがあるようです。

問題を解決するにはSJISの2バイト文字がUNICODEのどの部分に割り当てられているかを厳密に調査する必要があるように思えましたので、今回はこの検索方法は見送らせて頂きました。

大変ご丁寧なプログラムを御提示して頂いたにも関わらず大変申し訳ございません。

VBScriptを使用した正規表現での検索は他にも応用が利くと思いますので、今回は大変勉強になりました。
ありがとうございました。