[RESOLVED] Converting Text to a Long Value

[Mark Gambo]

Can we get a small sample mark? For future reference..?

I wanted to write a function that would format text in a RichText Box for a Calender control I was working on and I needed an easy way to indicate the color that I wanted to use other that using the Hex equivalent. I decided to use a collection to hold the values. I am using the String variable (ie. "vbRed") as the key, here is my code:

Option Explicit
Dim Colors As New Collection
 
Private Sub Command1_Click()
        With RichTextBox1
            .Visible = False 'Hide RTB to Prevents Flickering
            .Text = "" 'Clears previous text and formating
            
            .Text = "<B><U><FontName=Arial><FontSize=12>" & _
                              "<Color=Red>The</U></B> </Color=Red></FontSize=12>" & _
                              "<Color=Blue><B><FontSize=16>quick</FontSize=16> " & _
                              "</Color=Blue><Color=Brown></B><I><FontSize=18> brown" & _
                              "</FontSize=18></I></Color=Brown><Color=Purple> fox" & _
                              "</Color=Purple></Color=Red></B></FontName=Arial>" & _
                              vbNewLine & vbNewLine & vbNewLine & _
                              "<Left><B>Left</B></Left>" & vbNewLine & _
                              "<Center><B>Center</B></Center>" & vbNewLine & _
                              "<Right><B>Right</B></Right>"
            
            Call RichTextBoxFormat(RichTextBox1)
            .Visible = True
        End With
End Sub
 
Private Sub Form_Load()
    With Colors 'Collection for Colors
        .Add vbRed, "Red"
        .Add vbBlue, "Blue"
        .Add vbGreen, "Green"
        .Add vbYellow, "Yellow"
        .Add &H80FF&, "Orange"
        .Add vbWhite, "White"
        .Add vbBlack, "Black"
        .Add &HC0C000, "LtBlue"
        .Add &HFF00FF, "Purple"
        .Add &H404080, "Brown"
    End With
End Sub
 
Private Sub RichTextBoxFormat(RTB As RichTextBox)
Dim lngTag_Start As Long
Dim lngTag_End As Integer
Dim strTag_Start As String
Dim strTag_End As String
Dim strText As String
Dim a As Long
 
For a = 1 To 31
    strTag_Start = "<" & Choose(a, "B", "I", "U", "Center", "Left", _
                                    "Right", "Color=Red", "Color=Blue", _
                                    "Color=Green", "Color=Yellow", _
                                    "Color=Orange", "Color=White", _
                                    "Color=Black", "Color=LtBlue", _
                                    "Color=Purple", "Color=Brown", _
                                    "FontSize=8", "FontSize=10", "FontSize=12", _
                                    "FontSize=14", "FontSize=16", "FontSize=18", _
                                    "FontSize=20", "FontSize=22", "FontSize=24", _
                                    "FontName=Arial", "FontName=Arial Black", _
                                    "FontName=Comic Sans MS", _
                                    "FontName=French Script MT", _
                                    "FontName=Lucida Console", _
                                    "FontName=Old English Text", _
                                    "FontName=New Times Roman", _
                                    "FontName=EAN-13", "FontName=UPCA", _
                                    "FontName=UPCA", "FontName=UPC-E Short", _
                                    "FontName=3 of 9 Barcode") & ">"
                                        
    strTag_End = "</" & Mid(strTag_Start, 2)
    
    lngTag_End = 1
 
    With RTB
        strText = .Text
        
        Do While InStr(lngTag_End, strText, strTag_Start) > 0
            'Loops through the text to find each tag
            
            .SelLength = 0
            lngTag_Start = InStr(lngTag_End, strText, strTag_Start)
            lngTag_End = InStr(lngTag_Start, strText, strTag_End)
            .SelStart = lngTag_Start + Len(strTag_Start) - 1
            .SelLength = ((lngTag_End - lngTag_Start) - Len(strTag_End)) + 1
 
            Select Case strTag_Start 'Formats the text based upon tag
                Case "<B>"  'Bold Text
                    .SelBold = True
                Case "<I>"  'Italic Text
                    .SelItalic = True
                Case "<U>"  'Underline Text
                    .SelUnderline = True
                Case "<Center>" 'Center Align Text
                    .SelAlignment = rtfCenter
                Case "<Left>"   'Left Align Text
                    .SelAlignment = rtfLeft
                Case "<Right>"  'Right Align Text
                    .SelAlignment = rtfRight
                Case Else
                    If InStr(strTag_Start, "Color") > 0 Then 'Colors Text
                        .SelColor = Colors.Item((Mid(strTag_Start, 8, Len(strTag_Start) - 8)))
                    ElseIf InStr(strTag_Start, "FontSize") > 0 Then 'Font Size
                        .SelFontSize = (Mid(strTag_Start, 11, Len(strTag_Start) - 11))
                    ElseIf InStr(strTag_Start, "FontName") > 0 Then 'Font Name
                        .SelFontName = (Mid(strTag_Start, 11, Len(strTag_Start) - 11))
                    End If
            End Select
        
            lngTag_End = lngTag_End + 1
        Loop    'Check text for additional tags
 
        'Removes the Tags from the RichTextBox
        Do While .Find(strTag_Start, 0) <> -1
            .SelText = ""
        Loop
        
        Do While .Find(strTag_End, 0) <> -1
            .SelText = ""
        Loop
        .SelStart = 1
    End With
Next a
End Sub

Thanks to all that helped me with this code! Here is a link to my original post regarding RichTextBoxes and Tags.

A picture of the Calendar Form: