VBA Access: Wrap Text into Lines of an Array

So I have written a module that breaks up text into multiple lines mimicking word wrap. Each line of text becomes an item in an array which can be later used for populating text boxes, list boxes, whatever. I am wondering if there is a way to do this based on the visible length of the line as opposed to the character count. Since some characters are wider than others in most fonts, I have found my method of breaking the text up based on the string length to be unreliable at times. Here is my code:

Function breakText( _
ByVal textToRead As String, _
ByVal lineLength As Integer, _
Optional ByVal NoTrailingReturns As Boolean = True, _
Optional ByVal NoLeadingReturns As Boolean = False, _
Optional ByVal MaxNumbLines As Integer = -1 _
) As Variant
On Error GoTo err_breakText

Dim intSegmentLength As Integer
Dim intLineNumb As Integer
Dim strTextSegment As String
Dim strTextArray() As String

'Clear leading and trailing spaces
textToRead = Trim(textToRead)

'Replace all CrLf and isolated Lf with Cr's
textToRead = Replace(textToRead, vbCrLf, vbCr)
textToRead = Replace(textToRead, vbLf, vbCr)

'Clear unwanted LF/CR if NoTrailingReturns = true and/or NoTrailingReturns = true
If NoTrailingReturns = True Then
    While Right(textToRead, 1) = vbCr
        textToRead = Left(textToRead, Len(textToRead) - 1)
    Wend
End If
If NoLeadingReturns = True Then
    While Left(textToRead, 1) = vbCr
        textToRead = Right(textToRead, Len(textToRead) - 1)
    Wend
End If
textToRead = Trim(textToRead)

'Make sure we have a string to work with
If Len(textToRead) = 0 Then Err.Raise vbObjectError + 200, , "No text to read"

'Break text into lines and populate temp array
ReDim strTextArray(1)
intLineNumb = 1
Do
    'Take a section of the total string to process
    strTextSegment = Left(textToRead, lineLength + 1)
    'Determine the condition that ends the current line
    If InStrRev(strTextSegment, vbCr) > 0 Then
        'There is a CR in the string
        intSegmentLength = InStr(1, strTextSegment, vbCr)
        strTextSegment = Left(strTextSegment, intSegmentLength - 1)
    ElseIf Len(textToRead) < lineLength + 1 Then
        'The string is shorter than the line length
        intSegmentLength = Len(textToRead)
        strTextSegment = textToRead
    ElseIf InStrRev(strTextSegment, " ") Then
        'There is a space in the string
        intSegmentLength = InStrRev(strTextSegment, " ")
        strTextSegment = Left(strTextSegment, intSegmentLength - 1)
    Else
        'There are no breaks in the string
        intSegmentLength = lineLength
        strTextSegment = Left(strTextSegment, intSegmentLength)
    End If

    'Remove unwanted leading/trailing spaces from the redefined segment
    strTextSegment = Trim(strTextSegment)
    'Redefine and add the segment to the array
    ReDim Preserve strTextArray(0 To intLineNumb)
    strTextArray(intLineNumb) = strTextSegment
    'Remove the current segment from the remaining text and trim spaces
    textToRead = Right(textToRead, Len(textToRead) - intSegmentLength)
    textToRead = Trim(textToRead)
    intLineNumb = intLineNumb + 1

    'Check to see if we have any more lines available to populate
    'MaxNumbLines = -1 means there is no line count limit
    If intLineNumb > MaxNumbLines And MaxNumbLines > 0 Then
        Err.Raise vbObjectError + 100, , "Max line count met"
    End If
    If Len(textToRead) = 0 Then Exit Do

Loop

res_breakText:
    breakText = strTextArray
    Exit Function

err_breakText:

MsgBox Err.Description, , "Error " & Err.Number
Resume res_breakText

End Function