|
Hallo Jan,
und was ist wenn der Umbruch automatisch und nicht durch Enter geschieht? Scheint dann nicht zu funktioniert.
Ich habe dazu mal eine Funktion geschrieben, die ist aber noch weniger elegant und das korrekte darstellen von Leerzeichen am Anfang einer Zeile passt nicht ganz (die Zeilen werden aber korrekt getrennt).
Ansonsten funktioniert sie.
Option Explicit
Private Sub loadUForm()
uF.Show
End Sub
Function testLineBreak()
Dim I&
Dim Text$()
'function ausführen
findLinebreak uF.tbML, Text
'testen
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
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
Set UForm = uGetStringLenght
Set TB = UForm.TextBox1
TB2w = MLtb.Width
Str = MLtb.Text
With TB
.Font.Size = MLtb.Font.Size
End With
'comp len, find breakpoints
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
'leerzeichen entfernen
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
Viele Grüße
Till
|