Userform text colour

[Damo10]

Hi,

I have a userform that has several textboxes on it that have several lines of data in each, is it possible to change the font colour of an individual item in a textbox without changing all the items in it?

Regards

 

[Jaafar Tribak]

Jaafar, the link goes to a workbook that uses labels over listboxes to hightlight particular list items, no API.

Didn't occur to me the idea to use labels. I couldn't see the code because I couldn't log in.

 

[mikerickson]

Yes, the logic would be

Dim Highlights as New Collection
'...

Dim someItem as Variant
Dim aHighlight as clsListBoxHighlite

For someItem in Array("alpha","beta","gamma","adam","George")
    ListBox1.AddItem someItem
    
    If SomeItem Like "a*" Then
       Set aHighlight = New clsListBoxHighlite

        With aHighlight
            Set .ListBox = ListBox1
            .HighLite.BackColor = RGB(255, 0, 0)
        End With

        Highlights.Add item:=aHighlight, key:=aHighlight.Highlite.Name
        Set aHighlight = Nothing
    End If
Next someItem

 

[Rick Rothstein]

There is a text box that will allow you to color parts of the text independently from the rest of the text, but I don't know if it is automatically delivered with Windows or if it is on my system because I have the compiled version of Visual Basic 6.0 installed. So if the following doesn't work for you, then it must be because the control came with my compiled version of VB6.

Right click the UserForm's Toolbox and select "Additional Controls" from the popup menu that appears. When the "Additional Controls" dialog box appears, scroll down to the "Microsoft Rich Textbox Constr 6.0 (SP6)" entry and put a checkmark in the checkbox in front of it, then click OK. Now add a RichTextBox control to your UserForm (make it tall enough to display three lines of text) and also add a CommandButton. Use this simple CommandButton Click event code to demo the coloring of individual text (note that this control does a whole lot more than just allow colored text).

Private Sub CommandButton1_Click()
  With RichTextBox1
    .Text = "Line One" & vbLf & "Line Two" & vbLf & "Line Three"
    .Find "Line Two"
    .SelColor = RGB(255, 0, 0)
  End With
End Sub

Now, run the code and click the button.

 

[mikerickson]

Didn't occur to me the idea to use labels. I couldn't see the code because I couldn't log in.

Here's the code for the Class Module clsListBoxHighLite.
The code above gives an idea of how its used.
Note the .TransparentWhenSelected and .IsHeader properties.

Option Explicit

Public WithEvents xlbxHighLite  As MSForms.ListBox

Public WithEvents xlbxMain As MSForms.ListBox

Public WithEvents xfrmContainer As MSForms.Frame

Public WithEvents xmltContainer As MSForms.MultiPage


Public TransparentWhenSelected As Boolean
Dim zIsHeader As Boolean
Dim zHighLitedIndex  As Long, EventsDisable As Boolean

Property Get ListBox() As MSForms.ListBox
    Set ListBox = xlbxMain
End Property
Property Set ListBox(lbxListBox As MSForms.ListBox)
    Set xlbxMain = lbxListBox
    If xlbxHighLite Is Nothing Then
        zCreateHighLiteBox xlbxMain
    End If
    Call UpdateHighLite
End Property

Property Get Index() As Long
    Index = zHighLitedIndex
End Property
Property Let Index(inDx As Long)
    If zIsHeader Then
        zHighLitedIndex = 0
    Else
        zHighLitedIndex = inDx
    End If
    
    If Not ((xlbxMain Is Nothing) Or (xlbxHighLite Is Nothing)) Then
        Call UpdateHighLite
    End If
End Property

Property Get Highlite() As MSForms.ListBox
    Set Highlite = xlbxHighLite
End Property

Property Get IsHeader() As Boolean
    IsHeader = zIsHeader
End Property
Property Let IsHeader(inHead As Boolean)
    zIsHeader = inHead
    If zIsHeader Then
        Index = 0
    End If
End Property

Private Sub UpdateHighLite()
    Dim IndexToHighlite As Long
    
    IndexToHighlite = zHighLitedIndex

    Rem if IsHeader
    With xlbxHighLite
        If zIsHeader Then
            IndexToHighlite = xlbxMain.TopIndex: zHighLitedIndex = 0
            .BorderColor = RGB(0, 0, 0)
            .BorderStyle = fmBorderStyleSingle
        Else
            .BorderColor = xlbxHighLite.BackColor
            .BorderStyle = fmBorderStyleNone
        End If
    End With
    
    Rem adjust for scrollbar, the number 16 may be version specific
    With xlbxHighLite
        .Width = xlbxMain.Width + 16 * CDbl((xlbxMain.Height < (.Height - 2 * .BorderStyle) * xlbxMain.ListCount))
    End With
    
    If (-1 < IndexToHighlite) And (IndexToHighlite < xlbxMain.ListCount) Then
        With xlbxHighLite
            If Not (.Selected(0)) Then
            .Clear
            .AddItem xlbxMain.List(zHighLitedIndex, 0)
            End If
            .Top = xlbxMain.Top + (IndexToHighlite - xlbxMain.TopIndex) * (.Height) + 1 - .BorderStyle + CLng(Not TransparentWhenSelected)
            .Left = xlbxMain.Left
            .Visible = (xlbxMain.Top <= .Top) And (.Top <= xlbxMain.Top + xlbxMain.Height) And xlbxMain.Visible
            .Selected(0) = xlbxMain.Selected(IndexToHighlite) And TransparentWhenSelected
            
            .Enabled = xlbxMain.Enabled
            
        End With
    Else
        xlbxHighLite.Visible = False
    End If
End Sub

Private Sub zCreateHighLiteBox(lbxListBox As MSForms.ListBox)
    Rem make highlite list box
    With xlbxMain.Parent
        Set xlbxHighLite = .Controls.Add("forms.ListBox.1", Visible:=False)
        With xlbxHighLite
            .Height = 20: .Width = 20
            .Left = 20: .Top = 20
            .AddItem "x"
            '.Visible = False
        End With
    End With
    zMatchProperties
    
    Rem expose container to events
    Select Case TypeName(xlbxMain.Parent)
            Case "Frame"
        Set xfrmContainer = xlbxMain.Parent
            Case "Page"
        Set xmltContainer = xlbxMain.Parent.Parent
    End Select
End Sub

Private Sub zMatchProperties()
    
    Rem get height of highlite
    With xlbxMain.Parent.Controls.Add("forms.TextBox.1", Visible:=False)
        .Left = 10: .Top = 10
        Rem match font to main list box
        With .Font
            .Bold = xlbxMain.Font.Bold
            .Charset = xlbxMain.Font.Charset
            .Italic = xlbxMain.Font.Italic
            .Name = xlbxMain.Font.Name
            .Size = xlbxMain.Font.Size
            .StrikeThrough = xlbxMain.Font.StrikeThrough
            .Underline = xlbxMain.Font.Underline
            .Weight = xlbxMain.Font.Weight
        End With
        .AutoSize = True
        .Text = "X"
        xlbxHighLite.Height = .Height: Rem <<<<
        
        xlbxMain.Parent.Controls.Remove .Name
    End With
    
    With xlbxHighLite
        Rem initialize highlite properties to main listbox
        .Width = xlbxMain.Width
        .BackColor = xlbxMain.BackColor
        .BorderColor = .BackColor
        .BorderStyle = fmBorderStyleNone
        .Enabled = xlbxMain.Enabled
        With .Font
            .Bold = xlbxMain.Font.Bold
            .Charset = xlbxMain.Font.Charset
            .Italic = xlbxMain.Font.Italic
            .Name = xlbxMain.Font.Name
            .Size = xlbxMain.Font.Size
            .StrikeThrough = xlbxMain.Font.StrikeThrough
            .Underline = xlbxMain.Font.Underline
            .Weight = xlbxMain.Font.Weight
        End With
        .ForeColor = xlbxMain.ForeColor
        xlbxMain.IntegralHeight = True
        .IntegralHeight = True
        .ListStyle = xlbxMain.ListStyle
        .SpecialEffect = fmSpecialEffectFlat
        xlbxMain.SpecialEffect = fmSpecialEffectFlat
    End With
End Sub

Private Sub Class_Initialize()
    zHighLitedIndex = -1
    TransparentWhenSelected = True
End Sub

Private Sub Class_Terminate()
    Set xlbxHighLite = Nothing
    Set xlbxMain = Nothing
End Sub

Private Sub xlbxHighLite_Click()
    If EventsDisable Then Exit Sub
    EventsDisable = True
    If zIsHeader Then
        xlbxHighLite.Selected(0) = False
        xlbxMain.Selected(0) = False
    Else
        xlbxMain.Selected(zHighLitedIndex) = True
     End If
     xlbxMain.SetFocus
     
     With xlbxHighLite
        If 0 < .ListCount And -1 < zHighLitedIndex And Not (zIsHeader) Then
            .Selected(0) = (xlbxMain.Selected(zHighLitedIndex)) And TransparentWhenSelected
        End If
    End With
    
     UpdateHighLite
     
     EventsDisable = False
End Sub

Private Sub xlbxMain_Change()
    If EventsDisable Then Exit Sub
    EventsDisable = True
    If zIsHeader Then
        xlbxHighLite.Selected(0) = False
        xlbxMain.Selected(0) = False
    End If
    With xlbxHighLite
        If 0 < .ListCount And -1 < zHighLitedIndex And Not (zIsHeader) Then
            .Selected(0) = (xlbxMain.Selected(zHighLitedIndex)) And TransparentWhenSelected
        End If
    End With
    UpdateHighLite
ErrorHalt:
    Err.Clear
    On Error GoTo 0
    EventsDisable = False
End Sub

Private Sub xlbxMain_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    UpdateHighLite
End Sub
Private Sub xfrmContainer_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    UpdateHighLite
End Sub

Private Sub xmltContainer_Change()
    xlbxHighLite.Visible = Not (xmltContainer.Value = xlbxHighLite.Parent.Index)
    UpdateHighLite
End Sub

Private Sub xmltContainer_MouseMove(ByVal Index As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    UpdateHighLite
End Sub

 

[RoryA]

Just be aware of this.

 

[mikerickson]

I forgot a crucial step

Dim Highlights as New Collection
'...

Dim someItem as Variant
Dim aHighlight as clsListBoxHighlite

For Each someItem in Array("alpha","beta","gamma","adam","George")
    ListBox1.AddItem someItem
    
    If SomeItem Like "a*" Then
       Set aHighlight = New clsListBoxHighlite

        With aHighlight
            Set .ListBox = ListBox1
            .HighLite.BackColor = RGB(255, 0, 0)
            [COLOR="Red"].Index = ListBox1.ListCount - 1[/COLOR]
        End With

        Highlights.Add item:=aHighlight, key:=aHighlight.Highlite.Name
        Set aHighlight = Nothing
    End If
Next someItem

 

[Norie]

You could use a ListView control.

You can change the colour of items ^* in one without API or using other controls.

Slightly harder (than a ListBox) to work with at first but gets easier.

^* Not sure how flexible that is, eg you might only be able to colour rows.

 

[Jaafar Tribak]

Thanks Mike for the followup.

Looks good.

I noticed that the color strip overlaps the listbox scrollbar. Only when the mouse moves over the listbox the strip width is adjusted.

Also, the first item on the listbox is the only one that is painted when selected.

I must be missing something.


EDIT/

I see now- the code was meant to highlight entries wich start with an "a"

 

[Rick Rothstein]

Just be aware of this.

Thanks for the heads up. That is real shame as the RichTextBox is a really super control... lots of flexibility and way more useful than a normal TextBox. And yeah, I got the security warning, but only the first time I ran the UserForm... after that, the control worked perfectly which is why I posted about it.

 

[mikerickson]

There are some constants in that code that need to be adjusted for Windows versions, to adjust for things like scrollbar widths.

The important properties of a clsListBoxHighlite are

.ListBox - the listBox in question
.Index - which list item to highlight
.Hightlite - the Highlite (label) itself
..... used to format the highlight as in .Highlite.Font.Bold = True, .Highlite.BackColor = RGB(128,128,234)
.IsHeader - Highlites ListItem(0) and keeps it at the top as a header
.TransparentWhenSelected - determines apperance when a highlited item is selected