Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


11860 / 76734 ←次へ | 前へ→

【70403】助けて!WebBrowserサンプルプログラム
質問  as56  - 11/11/13(日) 12:01 -

引用なし
パスワード
   ネットのWebBrowserサンプルプログラムを改造して自己流で作成しました.
UserformのWebBrowserに文書を表示させ、検索文字すべてを色反転!
(VBA EXCEL2003 使用)
質問は、読み込み文書はテキストファイルはできますが、エクセルやワード、
PDFでの検索でエラーが出ます。解決方法を探しましたが、初心者では
無理そうなので助けてください.宜しくお願いします.
--------------------------------------------------------------------------
Public fina As String
Public asas As String
--------------------------------------------------------------------------
Private Sub UserForm_Initialize() 'この設定以外はWebBrowser表示されなかった??(VBA EXCEL2003)

fina = "C:\test.txt" 'TXTファイルは成功!エクセルファイルは失敗・・原因不明!!

WebBrowser1.Navigate fina ' UserForm2にWebBrowserを貼り付け

End Sub
--------------------------------------------------------------------------

Private Sub CommandButton2_Click()

'UserForm2に文字検索の処理ボタン貼り付け (WebBrowser1の表示文書)

  Dim fina As String
  Dim asas As String
  Dim Doc As Object
  Dim Body As Object
  Dim objRange As Object
  Dim BMK As String
  Dim L As Long
  
  asas = InputBox("検索文字を入力してください。")
  BMK = asas

    '検索文字列を入れておいてください。
  If Len(BMK) = 0 Then Exit Sub
  
  Set Doc = WebBrowser1.Document
  Set Body = Doc.Body
  Set objRange = Body.createTextRange
  
  '≫≫≫≫≫ 検索開始
  For L = 0 To 255
    If objRange.findText(BMK) = False Then Exit For
  Do While objRange.findText(BMK)
    '最初に見つかった位置を保存しておきます。
    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
------------------------------------------------------------------------
Private Sub CommandButton1_Click() 'UserForm2にボタンを貼り付け(文字検索入力終了)
Unload UserForm2
End Sub
-------------------------------------------------------------------------
Private Sub CommandButton3_Click() 'UserForm2にボタンを貼り付け(検索結果文字の反転色クリアー)
Unload UserForm2
UserForm2.Show
End Sub
--------------------------------------------------------------------------

2 hits

【70403】助けて!WebBrowserサンプルプログラム as56 11/11/13(日) 12:01 質問
【70404】Re:助けて!WebBrowserサンプルプログラム neptune 11/11/13(日) 14:18 発言
【70405】Re:助けて!WebBrowserサンプルプログラム as56 11/11/13(日) 19:12 お礼

11860 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free