Langen Text aus Word auf mehrere Zeilen mit fester Spaltenbreite verteilen

[Fennek]

Hallo,

mein PC ist schon "down", deshalb ein ungetester Code:
Lege ein leeres Workbook an mit dem Namen "wd_to_xl.xlsx", passe den Pfad an:

Code:

'im letzten Teil

With GetObject("c:\tmp\wd_to_xl.xlsx")
    For i = 1 To col.count
        .sheets(1).cells(i, 1) = col(i)
    Next i
    .Close 1 'schließen mit speichern
End With

Teste es mal.

mfg

Der gesamte Code (ungetestet):

Code:

' in MS Word

Sub Zeilen_anzeigen()
Dim Col As Collection: Set Col = New Collection
Dim l As Line

With ActiveDocument.ActiveWindow
    
    For p = 1 To .Panes(1).Pages.Count
        For r = 1 To .Panes(1).Pages(p).Rectangles.Count
            For i = 1 To .Panes(1).Pages(p).Rectangles(r).Lines.Count
                Set l = .Panes(1).Pages(p).Rectangles(r).Lines.Item(i)
                'Debug.Print l.Range
                Col.Add l.Range
            Next i
        Next r
    Next p
End With

'>>>>>> nach Excel <<<<<<<

With GetObject("c:\tmp\wd_to_xl.xlsx")
    For i = 1 To col.count
        .sheets(1).cells(i, 1) = col(i)
    Next i
    .Close 1 'schließen mit speichern
End With
Set Col = nothing
End Sub

[LuckyJoe]

Hi,

du brauchst das nicht in Word und Excel gesonders codieren, wenn du von Excel direkt auf Word zugreifen möchtest.

Dazu musst du im VBA-Projekt zunächst unter "Extras" -"Verweise" einbinden:
"Microsoft Word XX.0 Object Library" (XX ist deine installierte Word-Version).

Option Explicit
Dim objWord As Word.Application

Public Sub WordTextEinlesen()
   
    Dim wdDokument As Word.Document
    Dim strDokument As String
    Dim p, r, i, l
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    Set objWord = New Word.Application
   
    ' #### Hier deine Word-Datei anpassen!
    strDokument = "d:\Test.doc"
   
    Set wdDokument = objWord.Documents.Open(strDokument)
    objWord.Visible = True
   
    With wdDokument.ActiveWindow
        For p = 1 To .Panes(1).Pages.Count
            For r = 1 To .Panes(1).Pages(p).Rectangles.Count
                For i = 1 To .Panes(1).Pages(p).Rectangles(r).Lines.Count
                    Set l = .Panes(1).Pages(p).Rectangles(r).Lines.Item(i)
                    'Debug.Print "Zeile"; i; ": "; l.Range
                    ' #### Hier deine Spalte (und ggf. Zeilenversatz) anpassen!
                    ActiveSheet.Cells(i, 1) = l.Range
                Next i
            Next r
        Next p
    End With

    wdDokument.Close False
    objWord.Quit
    Set objWord = Nothing
   
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

Viel Erfolg!

[marylalou]

 
@LuckyJoe: Ich habe den Code in Excel VBA reingeschrieben (vorher auch Word eingebunden) und erhalte beim Ausführen des Makros folgende Fehlermeldung: "Fehler beim Kompilieren.: Ein benutzerdefinierter Typ ist nicht definiert.[color=rgba(0, 0, 0, 0.85)][color=rgba(0, 0, 0, 0.85)]"[/color][/color] Der Fehler bezieht sich auf die 2. Zeile des Codes "objWord As Word.Application".



@Fennek: Ich habe auch deine Variante probiert, bei mir wurde aber in Excel nicht mal ein Makro zum Ausführen angezeigt. Hat also irgendwie nicht geklappt … 

[LuckyJoe]

Hi,

offensichtlich sind die Farbformatierungen aus diesem Forum mitkopiert worden. Probiere mal, den Code ohne Formate zu kopieren:

Code:

Option Explicit
Dim objWord As Word.Application

Public Sub WordTextEinlesen()
 
    Dim wdDokument As Word.Document
    Dim strDokument As String
    Dim p, r, i, l
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    Set objWord = New Word.Application
 
    ' #### Hier deine Word-Datei anpassen!
    strDokument = "d:\Test.doc"
 
    Set wdDokument = objWord.Documents.Open(strDokument)
    objWord.Visible = True
 
    With wdDokument.ActiveWindow
        For p = 1 To .Panes(1).Pages.Count
            For r = 1 To .Panes(1).Pages(p).Rectangles.Count
                For i = 1 To .Panes(1).Pages(p).Rectangles(r).Lines.Count
                    Set l = .Panes(1).Pages(p).Rectangles(r).Lines.Item(i)
                    'Debug.Print "Zeile"; i; ": "; l.Range
                    ' #### Hier deine Spalte (und ggf. Zeilenversatz) anpassen!
                    ActiveSheet.Cells(i, 1) = l.Range
                Next i
            Next r
        Next p
    End With

    wdDokument.Close False
    objWord.Quit
    Set objWord = Nothing
 
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

[Fennek]

Hallo,

versuche es mal so:

- den Code in das Word-Document einfügen
- die sichtbare Excel-Datei von Hand speichern

Code:

' Text anlegen: =lorem(25,3)
' Excel: Speichern von Hand

Sub Zeilen_anzeigen()
Dim XL As Object, WB As Object
Dim Col As Collection: Set Col = New Collection
Dim l As Line

With ActiveDocument.ActiveWindow
    
    For p = 1 To .Panes(1).Pages.Count
        For r = 1 To .Panes(1).Pages(p).Rectangles.Count
            For i = 1 To .Panes(1).Pages(p).Rectangles(r).Lines.Count
                Set l = .Panes(1).Pages(p).Rectangles(r).Lines.Item(i)
                'Debug.Print l.Range
                Col.Add l.Range
            Next i
        Next r
    Next p
End With

Set XL = CreateObject("Excel.Application")
Set WB = XL.Workbooks.Add
XL.Visible = True

For i = 1 To Col.Count
    WB.sheets(1).Cells(i, 1) = Col(i)
Next i

Set Col = Nothing
Set WB = Nothing
Set XL = Nothing
End Sub

mfg

[marylalou]

@Fennek: Dann erhalte ich den Laufzeitfehler 438, das Objekt unterstützt diese Eigenschaft oder Methode nicht "Set WB = XL.Workbooks.Add"

@LuckJoe: Ich hatte den Code bereits kopiert und auch einmal komplett selbst geschrieben. Leider immer noch der Fehler, der sich auf die zweite Zeile des Codes bezieht: Fehler beim Kompilieren.: Ein benutzerdefinierter Typ ist nicht definiert

[Fennek]

solche Art der Fehlersuche ist via ein Forum nicht möglich / bzw zu mühsam

https://online-excel.de/excel/singsel_vba.php?f=119

Welche Excel-Version hast Du?

Windows oder MAC?
:
Der Code ist auf meinem System Win8.1, Office 2016 32 bit gelaufen.

Überlege die, ob du die Original Word-Datei hochladen kannst.

Die Zerlegung eines sehr langen Text in einer Zelle nur in Excel ist recht einfach:

- ein Do - Loop Schleife
- mit p = INSTR(p, Cells(1,1), " ") solange Leerzeichen suchen bis der String die richtige Länge hat.

So ein Code ist sehr einfach, aber langweilig.

[LuckyJoe]

Hi,

geh' mal im VBA-Projekt in der Menüzeile auf "Extras" - "Verweise" und kreuze dort an: "Microsoft Word xx.0 Object Library" (xx ist deine installierte Word-Version, die du dort angezeigt bekommst. Dann sollte es funktionieren.

[Fennek]

Hallo,

hier ein reiner Excel-Code passend zu deiner hochgeladenen Datei:

Code:

Const ll As Long = 40 'max Länge der Zeile
Sub T_1()
Dim Tx As String

Tx = Cells(1, 1)
rr = 10
p = 1
Do
    p_alt = p
    p = InStr(p_alt + 1, Tx, " ")
    If p > ll Then
        Cells(rr, 1) = Trim(Left(Tx, p_alt))
        Tx = Trim(Mid(Tx, p_alt))
        rr = rr + 1
        p = 1
    End If
Loop Until p = 0
Cells(rr, 1) = Trim(Tx)
Beep
End Sub

mfg

[marylalou]

@LuckyJoe: Leider trat wieder ein anderer Fehler auf 
@Fennek: Ich habe einfach mal deine Datei benutzt und siehe da, es klappt hervorragend!! Habe es auch schon mit einem längeren Text ausprobiert! Super, vielen Dank für all eure Hilfe!