Advanced text editing for VBA (excel) textbox

Question

Preamble

Recently I've been struggling with big excel spreadsheets that have a lot of text and comments (multiple people work on single document). It is tremendously hard to edit it again and again (considering new notes), since document navigating becomes pretty complicated at some point. So, I decided that I need some tool to get/set only the data I actually need at one moment (single cell content, corresponsive comment content, additional data for the cell's row on demand).

What is done so far

Fortunatelly the start was pretty easy. I filled UserForm with 4 textboxes (2 readonly, 2 for editing), that are filled with data of the selected comment (by index), and some buttons that allow to accept/discard changes and navigate between commented cells.

Questions itself

First of all, I need to keep text formatting when I take the text from cell. Currently I am not taking any formatting, just text. All I found by googling is that I can set formatting character by character, sort of like in the following pseudocode:

For i = 0 to Cells(Row, Col).Text.Length
    MyTextBox.Text(i).FormatOption1 = Cells(Row, Col).Text(i).FormatOption1
    ...
    MyTextBox.Text(i).FormatOptionN = Cells(Row, Col).Text(i).FormatOptionN
Next

But this approach feels to be stupid. So, question one is:

Is there a way to copy full text formatting (Font, B/I/U, color, Size for each letter in the cell) alongside with text, from cell to TextBox and backwards, with one line of code?

Second of all I actually need some formatting tools in the UserForm to do aforesaid text formatting in my form, so question two is:

Is there a way to add formatting tools (the ones that are located in Home->Font menu, or popup menu when you select some text in a cell) into UserForm to edit text in TextBox object?

P.S. using Excel 2013

A bit of addition: I somehow assume that if there is no direct way to do what I've described in questions - there has to be some custom-made toolbox object (sort of EvenRicherTextBox) that was created by someone before. I just cannot believe that issue never came up, but I have no idea what keywords I need to use in order to find that object.

Answer 1

You could try to create a custom class for this, here's an example of how it might look:

Class Module code (name the module "FormattedString")

Option Base 1

Private Type FSChar
    Letter      As Integer
    Bold        As Boolean
    Italic      As Boolean
    Underline   As Boolean
    Colour      As Long
    Size        As Integer
End Type

Private strCollection() As FSChar
Private strRange        As Excel.Range
Private txt             As String  


Public Property Let FString(value As Excel.Range)

    Set strRange = value
    txt = strRange.text

    ReDim strCollection(1 To Len(strRange.text)) As FSChar

    For i = 1 To Len(strRange.text)
        With strCollection(i)
            .Letter = Asc(Mid(strRange.text, i, 1))
            .Bold = (strRange.Characters(i, 1).Font.Bold = True)
            .Italic = (strRange.Characters(i, 1).Font.Italic = True)
            .Underline = (strRange.Characters(i, 1).Font.Underline = True)
            .Colour = strRange.Characters(i, 1).Font.ColorIndex
            .Size = strRange.Characters(i, 1).Font.Size
        End With
    Next

End Property


Public Property Get FString() As Excel.Range
    Set FString = strRange
End Property


Public Sub WriteFStringToCell(ByRef writeCell As Range)

writeCell.value = txt

    For i = 1 To UBound(strCollection)
        With writeCell.Characters(i, 1).Font
            .Bold = strCollection(i).Bold
            .Italic = strCollection(i).Italic
            .Underline = strCollection(i).Underline
            .ColorIndex = strCollection(i).Colour
            .Size = strCollection(i).Size
        End With
    Next i
End Sub

---

Example:
(Write something in A1 and format with different styles etc...)

Sub MacroMan()

Dim testClass As FormattedString
Set testClass = New FormattedString

testClass.FString = Range("A1")

testClass.WriteFStringToCell Range("A2")

End Sub