＞下記のオブジェクトからページ番号を取得する方法はございますでしょうか。
＞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を使用した正規表現での検索は他にも応用が利くと思いますので、今回は大変勉強になりました。 ありがとうございました。