Webブラウザコントロールで検索をするには？
解決どうもお世話になります。
Webブラウザコントロールの使い方で、また教えて頂けないでしょうか。
の「ドキュメントのテキストを検索する」という解説で、
■コード１
var rng = document.body.createTextRange();
if (rng.findText("sample")==true) {
rng.select();
rng.scrollIntoView();
}
というコードが書いてあるのですが、これを参考にして、私は次のようなＶＢのコードを書いてみました。
■コード２
Private WithEvents Body As MSHTML.HTMLBody
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Set Body = WebBrowser1.Document.Body
End Sub
Private Sub Command1_Click()
If Body.createTextRange.findText("テキスト") Then
Body.createTextRange.Select
Body.createTextRange.scrollIntoView True
End If
End Sub
私としては、コード１と２は内容的には同じだと思ったのですが、これを実行するとドキュメント全体が選択された状態になってしまいます。一体何がおかしいのでしょうか。
（ＭＳＤＮを詳しく読んではいますが、いまいち私にはピンと来ませんので、要領を得ない質問ですみません）
> 私としては、コード１と２は内容的には同じだと思ったのですが、
異なります。同じにするのならば、こうなりますね。
(コメント部を解除すると、動作の意味がわかるかも)
Private Sub Command1_Click()
Dim Rng As MSHTML.IHTMLTxtRange
Set Rng = Body.createTextRange()
'MsgBox Rng.htmlText, vbInformation
If Rng.findText("テキスト") Then
'MsgBox Rng.htmlText, vbInformation
Rng.Select
Rng.scrollIntoView True
End If
Set Rng = Nothing
End Sub
http://www.microsoft.com/japan/msdn/library/ja/jpisdk/dhtml/references/objects/obj_TextRange.asp
上記を読んでみると、このような事が書かれています。
》move、moveToElementText、findTextなどのメソッドを使って、
》TextRangeオブジェクトの先頭と末尾を移動させてその範囲を変更できる。
つまり、findTextを使うと、その TextRangeオブジェクトの範囲が
変更されるという事です。
マロンさんのコードでは、毎回 createRangeメソッドによって、
「新たなTextRangeオブジェクトを作り直している」ので、
TextRangeの範囲が、初期状態(BODY要素内の全ての範囲を示す)に
なってしまっていたわけですね。
なるほど。了解しました。
おっしゃるようにしましたらうまく行きました。
ところで、２回目の検索を次の位置へ移動したい場合、moveStartを使えば実現できるだろうと思って、次のようなコードをまず試しに書いてみました。
Dim Rng As MSHTML.IHTMLTxtRange
Set Rng = Body.createTextRange()
Rng.moveStart "character", 100 → 例えば５０文字目で１回目の検索がなされたとします
If Rng.findText("テキスト") Then
Rng.Select
Rng.scrollIntoView True
End If
Set Rng = Nothing
一応これで次の場所の"テキスト"を検索するようですが、問題はありませんでしょうか。
「100」という固定数値を使っている点に若干疑問を感じますが、
考え方としてはそれで良いかと。
以下は5年前、某所に投稿したサンプルです。参考になれば。
Text1に指定された語句を検索し、それを黄色く反転させています。
Private Sub Command1_Click()
Dim Doc As Object 'MSHTML.HTMLDocument
Dim Body As Object 'MSHTML.HTMLBody
Dim objRange As Object 'MSHTML.IHTMLTxtRange
Dim BMK As String
'Dim L As Long
'検索文字列を入れておいてください。
If Len(Text1.Text) = 0 Then Exit Sub
Set Doc = WebBrowser1.Document
Set Body = Doc.Body
Set objRange = Body.createTextRange
'≫≫≫≫≫ 検索開始
'For L = 0 To 255
' If objRange.findText(Text1.Text) = False Then Exit For
Do While objRange.findText(Text1.Text)
'最初に見つかった位置を保存しておきます。
If Len(BMK) = 0 Then BMK = objRange.getBookmark
'検索した語句を黄色く反転させる。
objRange.execCommand "BackColor", False, "YELLOW"
'論理カーソル位置を、検索した語句の末尾に移動させる。
objRange.collapse False
Loop
'Next L
'≪≪≪≪≪ 検索終了
'ついでに、最初に見つけた語句の位置までスクロールさせています。
If Len(BMK) Then
objRange.moveToBookmark BMK
objRange.scrollIntoView
End If
'最後は一応、後始末を。
Set objRange = Nothing
Set Body = Nothing
Set Doc = Nothing
End Sub
早速試してみました。
ご提示のコードは、文字列を検索して１度にすべての結果を黄色反転する訳ですね。
なるほど、納得いたしました。
ではもう一つのバリエーションとして、コマンドボタンを押す度に次の検索箇所へ移動して反転表示させる方法を考えてみますと、１つめの検索文字列の末尾を次の検索の開始位置にすればよいのだと思いますが、それを実現するにはブックマークとmoveStartを利用すればよいのでしょうか。
すみません。私の質問の仕方がおかしいようでした。
貴重なアドバイス感謝いたします。
また自分でいろいろと調べてみます。
検索ボタンを押す度に次の位置の文字列を検索できるようにするために、moveStartで位置を指定すれば良さそうということは理解できました。ありがとうございました。
ここで、moveStart を利用する目的として、私は次のようなことを考えました。
例えば、表示されているドキュメントのある文字列をマウスでドラッグ反転し、それと同じ文字列を反転文字列以降の位置から検索しようとする場合です。
リッチテキストボックスで SelStart スタートというのがありますが、これは、マウスでドラッグ反転させた文字列の先頭位置がセットされていますよね。
これと同じ事をWebブラウザコントロールで行った場合、SelStart と同じ結果を取得する方法ってあるのでしょうか。
また、
Rng.findText("テキスト")
で検索された時の文字列の位置を取得する方法として、
Set Rng = objForm.Body.createTextRange()
strTarget = Rng.Text
If Rng.findText("テキスト") Then
Rng.Select
lngPos = InStr(strTarget, Rng.htmlText)
Rng.scrollIntoView True
End If
のようなことを考えたのですが、これではいつも最初の位置しか取得できないですよね。
最初は moveStart で検索開始位置を指定していれば、検索された文字列の位置も適切に求まるのかな？ と思ったのですが、期待はずれでした。
何か良い方法があれば、是非アドバイス頂けないでしょうか。
> 表示されているドキュメントのある文字列をマウスでドラッグ反転し、
> それと同じ文字列を反転文字列以降の位置から検索しようとする場合です。
こういうことでしょうか？
Option Explicit
Private WithEvents Doc As HTMLDocument
Private moRng As IHTMLTxtRange
Private msText As String
Private Sub Command1_Click()
If moRng Is Nothing Then Exit Sub
If moRng.findText(msText) Then
moRng.Select
moRng.scrollIntoView
moRng.collapse False
Else
MsgBox "検索終了"
Set moRng = Nothing
End If
End Sub
Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
Set Doc = Nothing
End Sub
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Set Doc = WebBrowser1.Document
End Sub
Private Function Doc_onclick() As Boolean
Dim selRng As IHTMLTxtRange
Set selRng = Doc.selection.createRange
msText = selRng.Text
If Len(msText) Then
Set moRng = Doc.body.createTextRange
moRng.moveToBookmark selRng.getBookmark
moRng.moveStart "word"
End If
Set selRng = Nothing
Doc_onclick = True
End Function
どうもお世話になります。
貴重なアドバイスありがとうございました。早速試してみます！
結果をご報告します。
ご提示頂いたコードを参考に私のアプリに移植して試したところ、完璧にうまく行きました。
そこで私なりにちょっと工夫をして、試行錯誤ではありましたが、検索が終了したら findText の２番目のパラメータ（検索方向の指定）を負の値に、そして collapse の値をTrueに設定することで、逆方向にも検索できるようにしました。
結果は、何やらうまくやってくれるようです（笑）。
今回の問題がうまく解決できて、とても感激しております。
piさん、そして魔界の仮面弁士さん、本当にありがとうございました。
これからも、よろしくお願い致します。
「解決」にチェックを入れるのを忘れました。
| ツイート |  |