RichTextBoxで色を置換 (ID：111412)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

荒っぽいのですが。
とりあえずそれっぽい動きはすると思います。
おそらく一部の日本語処理でバグが生じてしまうと思いますが…

' 共通関数  ：キーワードハイライティング
Public Sub keywordHiliting(ByRef richTextBoxObj As RichTextBox, keyWord As String)

Dim index As Integer

Dim rtfRead As String
    Dim rtfWrite As String
    Dim ctbl As Long
    
    index = richTextBoxObj.SelStart

' RTF形式のテキストを取得
    rtfRead = richTextBoxObj.TextRTF

' 文字修飾クリア
    rtfRead = Replace(rtfRead, "\cf1\b ", "")
    rtfRead = Replace(rtfRead, "\\b0\cf0 ", "")
    'カラーテーブルを追加
    ctbl = InStr(rtfRead, "\viewkind")
    If ctbl <> 0 Then
        rtfRead = Left$(rtfRead, ctbl - 1) & "{\colortbl ;\red255\green0\blue0;}" & vbCrLf & Mid$(rtfRead, ctbl)
    End If
    
    
    ' strExpression に指定した文字列を、
    ' strPattern の正規表現にマッチした文字列に対し
    ' strReplaceWith に置換する

Dim objRegExp As New regExp                                     '正規表現オブジェクトを作成

Dim strExpression As String
    Dim strReplaceWith As String
    Dim strPattern As String
    
    strPattern = "(" + rtfEnc(keyWord) + ")"
    strReplaceWith = "\cf1\b $1\b0\cf0 "
    strExpression = rtfRead
    
    objRegExp.Pattern = strPattern                         '検索パターンの設定
    objRegExp.IgnoreCase = True                            '大文字小文字区別の設定(区別する)
    objRegExp.Global = True                                '置換候補の設定(文字列内のすべてのマッチにテストする)
    
    strExpression = objRegExp.Replace(strExpression, strReplaceWith) 'Replace メソッドで文字列の置換
    FormMain.Text1.Text = strExpression
    richTextBoxObj.TextRTF = strExpression
    richTextBoxObj.SelStart = index
End Sub

←解決時は質問者本人がここをチェックしてください。

戻る