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
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
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
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