|
Waren doch noch ein paar Fehler drinnen, so sollte es jetzt wirklich klappen:
Option Explicit
Sub testLineBreak()
Dim I&
Dim Text$()
uF.tbML.Value = "Multiline Textbox Zeilenweiseineinem Array speichern HalloLeute,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, Text
Cells.Clear
For I = 0 To UBound(Text)
Cells(I + 1, 1).Value = Text(I)
Next
uF.Show
End Sub
Private Function 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 TB.Width > TB2w Then
If Mid(Str, I - 2, 1) = " " Or Mid(Str, I - 1, 1) = " " Then
ReDim Preserve Text(J)
Text(J) = Mid(Str, S, I - S - 1)
J = J + 1
S = I
Else
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 + 1
breakable = True
Exit For
Else
breakable = False
End If
Next
If Not breakable Then
ReDim Preserve Text(J)
Text(J) = Mid(Str, S, I - S - 1)
J = J + 1
S = I - 1
End If
End If
ElseIf I = E Then
ReDim Preserve Text(J)
Text(J) = Mid(Str, S, I - S + 1)
End If
Next
End Function
|