So ich glaub ich hab es. Der erste Teil war einfach, aber Worttrennung bzw. Wort-Nicht-Trennung zu berücksichtigen...
uF muss deine Userform sein und tbML dein multiline Textfeld in dieser. Die Userform uGetStringLen musst du erstellen.
Diese muss eine Autofit Textbox enthalten (TextBox1). Sonst kanns nicht funktionieren.
Option Explicit
Sub sdfsdf()
Dim Text$()
uF.tbML.Value = "MultilineTextboxZeilenweiseineinemArrayspeichernHalloLeute,ichhabeproblemdasichgerndenTexteinerTextboxineinArraylesenmöchteaberdaich mit VBA nicht so bewandert bin fehlt mir da irgendwie der ansatz. So hab ich mir das Vorgestellt: Array(0) = erste Zeile der Texbox; Array(1)=zweite Zeile der Textbox .................Schonmal danke für jegliche Hilfe."
findLinebreak uF.tbML, "dsgfdsg", Text
Dim I&
For I = 0 To UBound(Text)
Cells(I + 1, 1).Value = Text(I)
Next
uF.Show
End Sub
Private Function findLinebreak(MLtb As Object, TestString$, ByRef Text$()) As Double
'dim
Dim UForm As uGetStringLenght
Dim TB As Object
Dim TB2w#
Dim breakable As Boolean
Dim Str$
Dim I&, J&, S&, K&, L&, 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 TB.Width > TB2w Then
If Mid(Str, I - 2, 1) = " " Or Mid(Str, I - 1, 1) = " " Then
ReDim Preserve Text(J)
Text(J) = Mid(MLtb.Text, S, I - S - 1)
J = J + 1
S = I - 1
Else
For K = I - 1 To S Step -1
If Mid(Str, K, 1) = " " Then
ReDim Preserve Text(J)
Text(J) = Mid(MLtb.Text, 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(MLtb.Text, S, I - S - 1)
J = J + 1
S = I - 1
breakable = False
End If
End If
ElseIf I = E Then
ReDim Preserve Text(J)
Text(J) = Mid(MLtb.Text, S, I - S + 1)
End If
Next
End Function
|