過去ログ

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　Ｐａｇｅ      12
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
　　　通常モードに戻る　　┃　　ＩＮＤＥＸ　　┃　　≪前へ　　│　　次へ≫　　　
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
　▼複数キーワードをハイライト(vbs)  YAma(作成f氏) 02/8/1(木) 9:55

　───────────────────────────────────────
　■題名 ： 複数キーワードをハイライト(vbs)
　■名前 ： YAma(作成f氏)
　■日付 ： 02/8/1(木) 9:55
　-------------------------------------------------------------------------
   
'複数キーワードをハイライト(&H)

'　　　　　　 By f

　　Dim BugWeb

　　Dim objDoc

　　Dim txtKeyword

　　Dim keyArray

　　Dim colorArray

　　Dim i

　　Set BugWeb = CreateObject("BugWeb.BugBrowserAPI")

　　If Not BugWeb Is Nothing Then

　　　　Set objDoc = BugWeb.CreateDocumentViewObject(BugWeb.ActiveView)

　　　　If objDoc Is Nothing Then

　　　　　　BugWeb.ShowMessage "IDocumentViewを作成できません。"

　　　　Else

　　　　　　colorArray = Array("#ffff66", "#a0ffff", "#99ff99", "#ff9999", "#ff66ff")

　　　　　　txtKeyword = BugWeb.SearchKeywordString

　　　　　　If "" <> Trim(txtKeyword) Then

　　　　　　　　txtKeyword = Replace(txtKeyword,"　"," ")

　　　　　　　　keyArray = Split(txtKeyword)

　　　　　　　　For i = LBound(keyArray) To UBound(keyArray)

　　　　　　　　　　If i > UBound(colorArray) Then

　　　　　　　　　　　　Exit For

　　　　　　　　　　End If

　　　　　　　　　　Set objRange = objDoc.document.selection.createRange()

　　　　　　　　　　If Not objRange Is Nothing Then

　　　　　　　　　　　　Do While objRange.findText(keyArray(i))

　　　　　　　　　　　　　　objRange.pasteHTML "<B style='BACKGROUND-COLOR: " & colorArray(i) & "; COLOR: black'>" & keyArray(i) & "</B>"

　　　　　　　　　　　　Loop

　　　　　　　　　　　　Set objRange = Nothing

　　　　　　　　　　End If

　　　　　　　　Next

　　　　　　End If

　　　　　　Set objDoc = Nothing

　　　　End If

　　　　Set BugWeb = Nothing

　　End If


				  
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
　　　通常モードに戻る　　┃　　ＩＮＤＥＸ　　┃　　≪前へ　　│　　次へ≫　　　
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　Ｐａｇｅ      12