AW: Wordtabelle nach exel
17.06.2009 17:04:13
fcs
Hallo Julian,
hier zwei Varianten. Tabellen jeweils als ganzes kopieren und zellenweise übertragen.
Bei meinen Beispiel-Prozeduren ist die Anwendung Word gestartet und die Worddatei geschlossen.
Gruß
Franz
'Erstellt mit Excel 2003
Sub TabellenKopierenausWordDok()
'Wordtabelle am Stück kopieren und einfügen
'Im Excel VBA-Editor unter Extras den Verweis auf die _
Microsoft Word Object Library aktivieren!!
Dim wks As Worksheet, Zeile As Long
Dim objDoc As Word.Document, strDocName As String
Dim objTab As Word.Table, iTab As Integer
Set wks = ActiveSheet
strDocName = "C:\Lokale Daten\Test\TabCopyTest.doc"
Zeile = 3 'Startzeile für das einfügen
'Worddocument schreibgeschützt öffnen
Set objDoc = Word.Documents.Open(Filename:=strDocName, ReadOnly:=True)
With wks
For iTab = 1 To objDoc.Tables.Count
Set objTab = objDoc.Tables(iTab)
objTab.Range.Copy
.Cells(Zeile, 1).Activate
'Wordtabelle als Text ohne Formate einfügen
.PasteSpecial Format:="Unicode-Text", Link:=False, _
DisplayAsIcon:=False
'Wordtabelle als HTML mit Zell-Formaten einfügen
' .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
False
'Nächste Einfügezeile
Zeile = .Cells.SpecialCells(xlCellTypeLastCell).Row + 2
Next
End With
objDoc.Close savechanges:=False
End Sub
Sub TabellenKopierenausWordDok_Var()
'Wordtabelle zellenweise in Excel eintragen
'Im Excel VBA-Editor unter Extras den Verweis auf die _
Microsoft Word Object Library aktivieren!!
Dim wks As Worksheet
Dim lngZeileExcel As Long, lngSpExcel As Long
Dim objDoc As Word.Document, strDocName As String
Dim objTab As Word.Table, iTab As Integer
Dim varInhalt, lngZeile As Long, lngSpalte As Long
Set wks = ActiveSheet
strDocName = "C:\Lokale Daten\Test\TabCopyTest.doc"
lngZeileExcel = 3 'Startzeile für das einfügen
'Worddocument schreibgeschützt öffnen
Set objDoc = Word.Documents.Open(Filename:=strDocName, ReadOnly:=True)
With wks
For iTab = 1 To objDoc.Tables.Count
Set objTab = objDoc.Tables(iTab)
For lngZeile = 1 To objTab.Rows.Count
lngSpExcel = 1 '1. Spalte in die Woedinhalte eingetragen werden sollen
For lngSpalte = 1 To objTab.Columns.Count
'Inhalt Wordzelle
varInhalt = objTab.Cell(lngZeile, lngSpalte).Range.Text
'letzte beiden Zeichen abschneiden
varInhalt = Left(varInhalt, Len(varInhalt) - 2)
'in Exceltabelle eintragen
wks.Cells(lngZeileExcel, lngSpExcel).Value = varInhalt
'nächste Einfüge Spalte im Exelblatt
lngSpExcel = lngSpExcel + 1
Next
lngZeileExcel = lngZeileExcel + 1
Next
'Leerzeilen zwischen Tabellen
lngZeileExcel = lngZeileExcel + 2
Next
End With
objDoc.Close savechanges:=False
End Sub