Clever-Excel-Forum

Normale Version: Langen Text aus Word auf mehrere Zeilen mit fester Spaltenbreite verteilen
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Seiten: 1 2
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
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!
 
@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 … 
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
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
@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
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.
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.
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
@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! Angel
Seiten: 1 2