Sub SeekColorReplace(strFirstChr As String, strLastChr As String, _
  intFirstAdjust As Integer, intLastAdjust As Integer, intColor As Long)
  Dim sPos As Long
  Dim ePos As Long
 
  With RichTextBox1
    .Visible = False
    sPos = 0
    Do
      sPos = InStr(sPos + 1, RichTextBox1.Text, strFirstChr) + intFirstAdjust
      If sPos > 0 Then
        ePos = InStr(sPos + 1, RichTextBox1.Text, strLastChr) + intLastAdjust
        If ePos > 0 Then
          .SelStart = sPos - 1
          .SelLength = ePos - sPos + 1
          .SelColor = intColor
          sPos = ePos + 1
        End If
      End If
    Loop Until sPos < 1
    .Visible = True
  End With
End Sub
 
Sub KeywordColorReplace(strKeyword As String, intColor As Long)
  Dim sPos As Long
  Dim ePos As Long
 
  With RichTextBox1
    .Visible = False
    sPos = 0
    Do
      sPos = InStr(sPos + 1, RichTextBox1.Text, strKeyword)
      If sPos > 0 Then
        If Mid(RichTextBox1.Text, sPos - 1, 1) = " " Or Mid(RichTextBox1.Text, _
          sPos - 1, 1) = vbCr Or _
        Mid(RichTextBox1.Text, sPos - 1, 1) = vbLf Or Mid(RichTextBox1.Text, _
        sPos - 1, 1) = "(" Or _
        Mid(RichTextBox1.Text, sPos - 1, 1) = ")" Then
          ePos = Len(strKeyword) + sPos - 1
          .SelStart = sPos - 1
          .SelLength = ePos - sPos + 1
          .SelColor = intColor
          sPos = ePos + 1
        End If
      End If
    Loop Until sPos < 1
    .Visible = True
  End With
End Sub

Cu David
--------------------------------------------
ist eine geniale Erfindung

Q-lympics ist geil