Hallo zusammen,
ich würde gerne eine Worddatei aus Excel heraus öffnen.
In der Worddatei alles markieren --> einfügen --> Tabelle --> Text in Tabelle umwandeln --> Trennzeichen Tabstopps!
Dann diese Tabelle kopieren und in eine Exceldatei einfügen.
Allerdings habe ich nur anfängerkenntnisse in VBA.
Könnte sich bitte jmd. den Code anschauen?
Er bricht immer bei
With objWordDoc
Selection.WholeStory
ab und geht zu "aufräumen"
Vielen Dank!!
Option Explicit
Sub Berechnung_auslesen()
Dim AppWD As Object, objWordDoc As Object
Dim objWordRange As Object
Dim wdSeparateByTabs As Object, wdAutoFitFixed As Object
On Error GoTo aufräumen
Set AppWD = CreateObject("Word.Application")
AppWD.Visible = True
Set objWordDoc = AppWD.documents.Open("C:\Users\..... 2017.docx")
With objWordDoc
Selection.WholeStory
Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=3, _
NumRows:=48, AutoFitBehavior:=wdAutoFitFixed
End With
With objWordDoc
.Style = "Tabellenraster"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
End With
Selection.Copy
Workbooks("Berechnungen.xlsm").Sheets("Berechnung").Select
Range("A1").Select
ActiveSheet.Paste
aufräumen:
Set objWordRange = Nothing
If Not objWordDoc Is Nothing Then objWordDoc.Close savechanges:=True
Set objWordDoc = Nothing
If Not AppWD Is Nothing Then AppWD.Quit
Set AppWD = Nothing
End Sub
ich würde gerne eine Worddatei aus Excel heraus öffnen.
In der Worddatei alles markieren --> einfügen --> Tabelle --> Text in Tabelle umwandeln --> Trennzeichen Tabstopps!
Dann diese Tabelle kopieren und in eine Exceldatei einfügen.
Allerdings habe ich nur anfängerkenntnisse in VBA.
Könnte sich bitte jmd. den Code anschauen?
Er bricht immer bei
With objWordDoc
Selection.WholeStory
ab und geht zu "aufräumen"
Vielen Dank!!
Option Explicit
Sub Berechnung_auslesen()
Dim AppWD As Object, objWordDoc As Object
Dim objWordRange As Object
Dim wdSeparateByTabs As Object, wdAutoFitFixed As Object
On Error GoTo aufräumen
Set AppWD = CreateObject("Word.Application")
AppWD.Visible = True
Set objWordDoc = AppWD.documents.Open("C:\Users\..... 2017.docx")
With objWordDoc
Selection.WholeStory
Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=3, _
NumRows:=48, AutoFitBehavior:=wdAutoFitFixed
End With
With objWordDoc
.Style = "Tabellenraster"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
End With
Selection.Copy
Workbooks("Berechnungen.xlsm").Sheets("Berechnung").Select
Range("A1").Select
ActiveSheet.Paste
aufräumen:
Set objWordRange = Nothing
If Not objWordDoc Is Nothing Then objWordDoc.Close savechanges:=True
Set objWordDoc = Nothing
If Not AppWD Is Nothing Then AppWD.Quit
Set AppWD = Nothing
End Sub