However, Rich Text provides a huge number of features not provided by the RichTextBox control. Two of these are numbered lists and bulleted lists with special bullets. This example adds RTF formatting codes to the control's text to provide those features.

If you select some text in the control and click the Numbered List button, the following code executes. This routine begins by defining string constants that represent pieces of the RTF formatting codes. It uses the RichTextBox control's SelText property to get the selected text and splits the text into lines.

The control then starts building the RTF codes it will add to the control. It starts with the codes in RTF_NUMSTART and the first line of text.

Then for each remaining line in the selected text, the code adds the line followed by the codes in RTF_NUMITEM.

After adding all of the lines, the code removes the final carriage return and line feed and adds the RTF codes in RTF_NUMEND.

Finally the code sets the RichTextBox control's SelRTF property to the RTF codes it has built.

Private Sub cmdNumberedList_Click()
Const RTF_NUMSTART As String = _
    "{\rtf1\ansi\deff0\deftab720{\fonttbl{\f0\fswiss MS " & _
        "Sans Serif;}{\f1\froman\fcharset2 " & _
        "Symbol;}{\f2\fnil\fprq2\fcharset2 " & _
        "Wingdings;}{\f3\froman\fprq2 Times New Roman;}}" & _
        vbCrLf & _
    "{\colortbl\red0\green0\blue0;}" & vbCrLf & _
    "\deflang1033\pard\li720\fi-360\plain\f3\fs24 1.\tab "
Const RTF_NUMITEM As String = _
    "\par @%@.\tab "
Const RTF_NUMEND As String = "\par }"

Dim new_text As String
Dim old_text As String
Dim lines() As String
Dim i As Integer

    ' Get the current text.
    old_text = rtfTest.SelText
    lines = Split(old_text, vbCrLf)
    If LBound(lines) > UBound(lines) Then Exit Sub

    ' Start the list.
    new_text = RTF_NUMSTART & lines(0) & vbCrLf

    ' Add the other lines.
    For i = 1 To UBound(lines)
        new_text = new_text & _
            Replace(RTF_NUMITEM, "@%@", i + 1) & _
            lines(i) & vbCrLf
    Next i

    ' Remove the final vbCrLf.
    new_text = Left$(new_text, Len(new_text) - Len(vbCrLf))

    ' End the list.
    new_text = new_text & RTF_NUMEND

    ' Save the result.
    rtfTest.SelRTF = new_text

    rtfTest.SetFocus
End Sub

Private Sub cmdSpecialBullets_Click()
Const RTF_BULSTART As String = _
    "{\rtf1\ansi\deff0\deftab720{\fonttbl{\f0\fswiss MS " & _
        "Sans Serif;}{\f1\froman\fcharset2 " & _
        "Symbol;}{\f2\froman\fprq2 Times New " & _
        "Roman;}{\f3\fnil\fprq2\fcharset2 Wingdings;}}" & _
        vbCrLf & _
    "{\colortbl\red0\green0\blue0;}" & vbCrLf & _
    "\deflang1033\pard\li1080\fi-360\tx1080\plain\f3\fs24 " & _
        "v\tab \plain\f2\fs24 "
Const RTF_BULITEM As String = _
    "\par \plain\f3\fs24 v\tab \plain\f2\fs24 "
Const RTF_BULEND As String = "\par }"

Dim new_text As String
Dim old_text As String
Dim lines() As String
Dim i As Integer

    ' Get the current text.
    old_text = rtfTest.SelText
    lines = Split(old_text, vbCrLf)
    If LBound(lines) > UBound(lines) Then Exit Sub

    ' Start the list.
    new_text = RTF_BULSTART & lines(0) & vbCrLf

    ' Add the other lines.
    For i = 1 To UBound(lines)
        new_text = new_text & RTF_BULITEM & lines(i) & _
            vbCrLf
    Next i

    ' Remove the final vbCrLf.
    If UBound(lines) > 1 Then
        new_text = Left$(new_text, Len(new_text) - _
            Len(vbCrLf))
    End If

    ' End the list.
    new_text = new_text & RTF_BULEND

    ' Save the result.
    rtfTest.SelRTF = new_text

    rtfTest.SetFocus
End Sub

Notes

• When you select text, don't include the following carriage return. If you do, then that carriage return becomes part of the list and you get a blank item that is either numbered or bulletted.
• To create other, similar effects, use WordPad to create an RTF file that holds the effects. Then open the file in Notepad to learn the RTF codes that you need.