Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 336
  • Last Modified:

RTB Replace Text Colors Not working

basically Im trying to replace the text in the RTB when it detects the symbol "Á" + Letter (each letter represents a different color), It's suppose to be replace text colors when text is added with Á symbol, but it dosnt seem to be working. any suggestions?


If InStr(Form1.RTB.text, "Á") > 0 Then

Dim sOne As String, iOne As Long
With Form1.RTB

Do Until InStr(.text, "Á") = 0
  iOne = InStr(.text, "Á"): .SelStart = iOne: .SelLength = 1: sOne = .SelText: .SelStart = iOne - 1: .SelLength = Len(.text)
 
  Select Case sOne
    Case "R": .SelColor = vbGreen
    Case "P": .SelColor = vbWhite
    Case "S": .SelColor = vbYellow
    Case "T": .SelColor = vbCyan
    Case "Q": .SelColor = &H808080
    Case "V": .SelColor = vbCyan
    Case "U": .SelColor = vbCyan
    Case "Y": .SelColor = vbRed
  End Select
  .SelStart = iOne - 1: .SelLength = 2: .SelText = ""
Loop

End if
0
andyakira
Asked:
andyakira
  • 2
  • 2
1 Solution
 
JR2003Commented:
I take it you want to just change the colour of the letter next to the Á symbol and delete the Á symbol?

This code does the job:

Private Sub Command1_Click()
   
    Dim iPosStart As Long
    Dim sText As String
    iPosStart = 1 'Initialise
   
    With RTB
   
        Do Until InStr(iPosStart, .Text, "Á") = 0
            iPosStart = InStr(.Text, "Á")
            .SelStart = iPosStart - 1
            .SelLength = 1
            .SelText = ""
            .SelLength = 1
           
            Debug.Print .SelText
           
            Select Case .SelText
                Case "R": .SelColor = vbGreen
                Case "P": .SelColor = vbWhite
                Case "S": .SelColor = vbYellow
                Case "T": .SelColor = vbCyan
                Case "Q": .SelColor = &H808080
                Case "V": .SelColor = vbCyan
                Case "U": .SelColor = vbCyan
                Case "Y": .SelColor = vbRed
                Case Else: .SelColor = RGB(100, 100, 10)
            End Select
        Loop

    End With

End Sub

0
 
JR2003Commented:
If you want to remove your formatting chars and colou the rest of the text the code defined colour this code will do the job:

Private Sub Command1_Click()

    Dim iPosStart As Long
    Dim sText As String
    Dim iColour As Long
    iPosStart = 1 'Initialise
   
    With RTB
   
        Do Until InStr(iPosStart, .Text, "Á") = 0
            iPosStart = InStr(.Text, "Á")
            .SelStart = iPosStart - 1
            .SelLength = 1
            .SelText = ""
            .SelLength = 1
           
            Debug.Print .SelText
           
            Select Case .SelText
                Case "R": iColour = vbGreen
                Case "P": iColour = vbWhite
                Case "S": iColour = vbYellow
                Case "T": iColour = vbCyan
                Case "Q": iColour = &H808080
                Case "V": iColour = vbCyan
                Case "U": iColour = vbCyan
                Case "Y": iColour = vbRed
                Case Else: iColour = RGB(100, 100, 10)
            End Select
            .SelText = ""
            .SelLength = Len(.Text) - (iPosStart - 1)
            .SelColor = iColour
        Loop

    End With

End Sub

0
 
andyakiraAuthor Commented:
Hm ÁZ is printing black :(
0
 
andyakiraAuthor Commented:
im trying to get every text after ÁX  to be colored
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now