Also dann die (abgespeckte) Fkt,...
31.12.2007 01:09:15
Luc:-?
...Olaf!
Rem Aufteilung eines Langtextes in Zeilen innerhalb einer Zelle -
' TextLgLimit bei num or Aufruf aus and Pgm: 255 Zeichen - sonst nur xlWorksheetTextLgLimit
' Autor LSr.CyWorX -CDate 2003/4 -LUpdate 20070424t -Anpass f.Pub auf herber 20071231
Function TxInLines(ByVal Text As String, Optional ByVal MaxZLänge, Optional ByVal RefZelle)
Dim fs As Integer, i As Integer, j As Integer, k As Integer, p As Integer, mzl As Integer, _
_
a As String, b As String, c As String, z As Boolean
Const UbrZ = "([{-)]};:=%!?_+*/&| ,."
On Error Resume Next
If IsError(Application.Caller) Then z = True
If IsMissing(RefZelle) Then
Set RefZelle = ActiveCell
End If
With RefZelle
fs = IIf(.Font.Size = 0, 1, .Font.Size)
If IsMissing(MaxZLänge) Then
mzl = CInt(.Width * 1.888 / fs - .Font.Size / 4)
mzl = IIf(mzl 0 Then mzl = MaxZLänge Else TxInLines = CVErr(2015): GoTo ex
Else: TxInLines = CVErr(2036): GoTo ex
End If
End With
k = WorksheetFunction.RoundUp(Len(Text) / mzl, 0)
If k 255) Then 'TextLgLimit bei num or _
Aufruf aus anderem Pgm
TxInLines = Text
ElseIf Len(Text) > mzl Then
For i = 0 To k
j = 0
If Len(TxInLines) - i + 1 > Len(Text) Then Exit For
a = Mid(Text, Len(TxInLines) - i + 1, mzl)
Do While IsNumeric(a) 'Sicherung gg Zerreißen _
v.Zahlen
j = j + 1
a = Mid(Text, Len(TxInLines) - i + 1, mzl + j)
If Not IsNumeric(Right(a, 1)) Then
a = Left(a, Len(a) - 1)
Exit Do
ElseIf Mid(Text, Len(TxInLines) - i + Len(a) + 1, 1) = "" Then Exit Do
End If
Loop
For j = 0 To mzl - 1
b = Left(a, mzl - j)
c = Mid(a, mzl - j + 1)
If Len(a) 19
If IsNumeric(Mid(a, mzl - j - 1, 1)) And IsNumeric(Mid(a, mzl - j + 1, 1)) _
Then
Rem bei numerischen Textteilen entfallen `, .´ als UbrZ
Else: Exit For
End If
Case Else
Exit For
End Select
Next j
If j = mzl And c "" Then
TxInLines = TxInLines & b & vbLf
If a = b & Left(c, Len(a) - Len(b)) "" Then
c = Mid(c, Len(a) - Len(b) + 1)
End If
ElseIf c = "" And Len(TxInLines) + Len(a) - i
Die zusätzlichen Trenntiefstriche wdn von der Forumssoftware eingefügt. Ich habe nur einen bei der Dim-Anweisung eingefügt. Die anderen kannst du entfernen!
Das Ganze hat ein wenig gedauert, weil ich die udFkt noch um 1 Argument, etliche dann unnötige Variablen, 2 weitere verwendete udFktt und einige Codezeilen "erleichtern" musste... ;-)
Falls du dazu noch Anwendungshinweise und -beispiele benötigst, kann ich dir auch noch den Hilfetext dazu aus meinem FktPaket posten.
Für deinen Zweck musst du die Fkt auf jeden Fall noch in eine Formel einbinden, die nach den erzeugten Zeilenumbrüchen (Zeichen(10)) fragt.
Du (und alle anderen Leser) kannst die Fkt natürlich auch noch vielseitiger einsetzen... ;-)
Gruß und schon mal Guten Rutsch!
Luc :-?
PS: Wenn du das auch für Zellbezüge geltende TextLgLimit umgehen willst, musst du die Fkt direkt "um den Text herum" schreiben (dafür habe ich auch eine Subroutine...).