Option Explicit
Private Sub loadUForm()
uF.Show
End Sub
Function testLineBreak()
Dim I&
Dim Text$()
findLinebreak uF.tbML, Text
Cells.Clear
For I = 0 To UBound(Text)
Cells(I + 1, 1).Value = Text(I)
Next
End Function
Private Sub findLinebreak(MLtb As Object, ByRef Text$())
Dim UForm As uGetStringLenght
Dim TB As Object
Dim TB2w#
Dim breakable As Boolean
Dim Str$
Dim I&, J&, S&, K&, E&
Dim BPs&()
Set UForm = uGetStringLenght
Set TB = UForm.TextBox1
TB2w = MLtb.Width
Str = MLtb.Text
With TB
.Font.Size = MLtb.Font.Size
End With
S = 1
E = Len(MLtb.Text)
For I = 1 To E
TB.Text = Mid(Str, S, I - S)
If Mid(Str, I, 1) = Chr(10) Then
ReDim Preserve Text(J)
Text(J) = Mid(Str, S, I - S - 1)
J = J + 1
S = I
ElseIf TB.Width > TB2w Then
If Mid(Str, I - 1, 1) = " " Or Mid(Str, I, 1) = " " Then
ReDim Preserve Text(J)
Text(J) = Mid(Str, S, I - S)
J = J + 1
S = I
Else
breakable = False
For K = I - 1 To S + 1 Step -1
If Mid(Str, K, 1) = " " Then
ReDim Preserve Text(J)
Text(J) = Mid(Str, S, K - S)
J = J + 1
S = K
breakable = True
Exit For
End If
Next
If Not breakable Then
ReDim Preserve Text(J)
Text(J) = Mid(Str, S, I - S + 1)
J = J + 1
S = I
End If
End If
ElseIf I = E Then
ReDim Preserve Text(J)
Text(J) = Mid(Str, S, I - S + 1)
End If
If J > 0 Then
If Mid(Text(J - 1), 1, 1) = " " Then
Text(J - 1) = Mid(Text(J - 1), 2, Len(Text(J - 1)) - 1)
End If
End If
Next
End Sub