Langen Text in gleichlange Zeilen verteilen (autom. Zeilenumbruch)

  • VBScript

Es gibt 4 Antworten in diesem Thema. Der letzte Beitrag () ist von Sachsenbauch.

    Langen Text in gleichlange Zeilen verteilen (autom. Zeilenumbruch)

    Schon geraume Zeit beschäftigt mich das Thema BLOCKTEXT, d.h. das zeilenweise zerteilen eines langen Textes in (fast) gleichlange Textzeilen, ohne dabei die Wörter zu "zerteilen".
    In den Tiefen des WWW habe ich eine Lösung für Excel gefunden, bei der Text der aktuellen Zelle in mehrere Zeilen (mit einer anzugebenden Zeilen-Länge) automatisch umgebrochen wird. So etwas hätte ich gerne für die Eingabeaufforderung (als VBScript), so daß ich zukünftige Textdateien (Plain Text) nicht erst ins Excel importieren und nach Abarbeitung des Makros wieder exportieren muss.
    Hier einmal der Quelltext für VBA

    Visual Basic-Quellcode

    1. Sub VerteilText()
    2. Dim dum$, SollBr%, anzT%, tt$()
    3. Dim zz1&, zze&, zz&, ss1%, sse%, ss%, nn&, vv&, ii%
    5. dum = InputBox("Bitte die maximale Breite des Textes eingeben.", _
    6. "Verteilung für die ausgewählten Zellen", 62)
    7. If dum = "" Then Exit Sub
    8. If IsNumeric(dum) Then SollBr = dum
    9. If SollBr < 3 Then
    10. MsgBox "Max. Breite ist kleiner als 3!", vbCritical, "VerteilText"
    11. Exit Sub
    12. End If
    13. anzT = 3
    14. ReDim tt(anzT)
    15. ' --------------------- Nummern der Start- und Endzeile/-spalte
    16. With Intersect(Selection, ActiveSheet.UsedRange)
    17. zz1 = .Row
    18. zze = .Rows.Count + zz1 - 1
    19. ss1 = .Column
    20. sse = .Columns.Count + ss1 - 1
    21. End With
    22. ' --------------------------------------------------- Verteilen
    23. For zz = zze To zz1 Step -1
    24. vv = 0
    25. For ss = ss1 To sse
    26. nn = 0
    27. tt(nn) = Cells(zz, ss)
    28. Do While Len(tt(nn)) > SollBr
    29. ii = InStrRev(tt(nn), " ", SollBr + 1)
    30. If ii > 0 Then
    31. ' Teiltexte ermitteln
    32. If nn + 1 > anzT Then anzT = anzT + 3: ReDim Preserve tt(anzT)
    33. tt(nn + 1) = Mid(tt(nn), ii + 1)
    34. tt(nn) = Left(tt(nn), ii - 1)
    35. nn = nn + 1
    36. Else
    37. ' Wort zu lang
    38. MsgBox "Zu langes Wort in Zelle " _
    39. & Cells(zz, ss).Address(False, False, xlA1), _
    40. vbInformation, "VerteilText"
    41. Exit Do
    42. End If
    43. Loop
    44. ' Teiltexte einfügen, evtl. in neue Zeilen
    45. If nn > 0 Then
    46. For ii = 0 To nn
    47. If ii > vv Then ActiveSheet.Rows(zz + ii).Insert: vv = vv + 1
    48. Cells(zz + ii, ss) = tt(ii)
    49. Next ii
    50. End If
    51. Next ss
    52. Next zz
    53. End Sub

    Als Neuling habe ich von VBA bzw. VBS nicht allzuviel Ahnung,von VB oder VB.,Net gleich gar nicht.Vielleicht kann mir das irgendjemand eine Hilfe geben.
    Danke ersteinmal :rolleyes:

    Visual Basic-Quellcode

    1. Option Explicit
    2. Dim fso, zl, t, p
    3. Dim InputFile, OutputFile
    5. Const FOR_Input = 1, FOR_Output = 2
    6. zl = 62 'Zeilenlänge
    8. Set fso = WScript.CreateObject("Scripting.Filesystemobject")
    10. Set InputFile = fso.OpenTextFile("C:\##\input.txt", For_Input)
    11. Set OutputFile = fso.OpenTextFile("C:\##\output.txt", FOR_Output,True)
    13. Do Until InputFile.AtEndOfStream
    14. t = InputFile.ReadLine
    15. Do While Len(t) > zl
    16. p = InStrRev(t, " ", zl)
    17. If p Then
    18. OutputFile.WriteLine(Left(t, p - 1))
    19. t = Mid(t, p + 1)
    20. Else
    21. Exit Do
    22. End If
    23. Loop
    24. If Len(t) Then OutputFile.WriteLine(t)
    26. Loop
    28. InputFile.Close
    29. OutputFile.Close
    30. MsgBox("Fertig")

    Herzlichen Dank Eierlein,
    wie immer zur vollsten Zufriedenheit gelöst.
    Ich habe nur die konstante Umbruchspalte durch eine Inputbox-Abfrage ersetzt.

    Visual Basic-Quellcode

    1. zl=CInt(Inputbox("Zeilenumbruch nach wieviel Spalten ?","manueller Zeilenumbruch",24)) ' nur ganze Zahlen

    Schön wäre es jetzt, wenn man daraus noch einen echten Blocksatz machen könnte, d.h. die Anzahl der Leerzeichen so erhöht und verteilt, daß der rechte Rand immer glatt ist und bei Spalte 62 aufhört.
    Das würde dem ganzen ein profimäßiges Aussehen verleihen und damit ein echter BLOCKSATZ sein... ;)

    Also nochmals vielen Dank und einen schönen Tag

    Mit Blocksatz:

    Visual Basic-Quellcode

    1. Option Explicit
    2. Dim fso, zl, t, t1, p, pp, p1, lz, l
    3. Dim InputFile, OutputFile
    5. Const FOR_Input = 1, FOR_Output = 2
    6. zl = 62 'Zeilenlänge
    8. Set fso = WScript.CreateObject("Scripting.Filesystemobject")
    10. Set InputFile = fso.OpenTextFile("d:\input.txt", For_Input)
    11. Set OutputFile = fso.OpenTextFile("d:\output.txt", FOR_Output,True)
    13. Do Until InputFile.AtEndOfStream
    14. t = InputFile.ReadLine
    15. Do While Len(t) > zl
    16. p = InStrRev(t, " ", zl)
    17. If p Then
    18. t1 = Left(t, p - 1)
    19. t = Mid(t, p + 1)
    20. l = Len(t1)
    21. If l < zl Then
    23. p1 = 1 : lz = 0
    24. While InStr(p1, t1, " ")
    25. pp = InStr(p1, t1, " ")
    26. If pp Then lz = lz + 1
    27. p1 = pp + 1
    28. Wend
    30. While l < zl
    31. t1 = Replace(t1, " ", " ",1, zl-l)
    32. l = Len(t1)
    33. Wend
    35. OutputFile.WriteLine(t1)
    37. End If
    38. Else
    39. Exit Do
    40. End If
    41. Loop
    42. If Len(t) Then OutputFile.WriteLine(t)
    44. Loop
    46. InputFile.Close
    47. OutputFile.Close
    48. MsgBox("Fertig")
    Dateien

    • input.txt

      (7,86 kB, 289 mal heruntergeladen, zuletzt: )

    Blocktext.vbs zur vollsten Zufriedenheit gelöst . DANKE

    Hallo Eierlein,
    bitte entschuldige mein spätes Feedback - ich war ein bisschen indisponiert

    Ich bin - wie immer - hellauf begeistert von Deinem Code und ich danke Dir ganz herzlich für Deine Mühe.
    So habe ich mir das gewünscht.

    Also nochmals herzlichen Dank, abschließend wünsche Dir noch einen schönen heißen Sonntag... 8o

Facebook
Telefonspende