Startseite Inhaltsverzeichnis Nutzungsbedingungen Datenschutz Impressum Weitere Informationen

CODE-SCHNIPSEL

Alle Tabellen aus einem Dokument nach Excel® exportieren

VBA und Makros • Codeschnipsel • Tabellen • Export • Dokument • Automatisierung

Ausgangslage ... Was tut der Codeschnipsel?

Ein kleiner Beispielquelltext, um alle Tabellen eines Dokumentes in eine neue leere Excel® Arbeitsmappe zu exportieren.

VBAVBA Codeschnipsel
XLSQuelltext zur Verwendung mit Microsoft® Excel®
DOCQuelltext zur Verwendung mit Microsoft® Word®

Der Quelltext ...

Option Explicit
' ****************************************************************
' Autor/en und Original-Quelltext unter:
' https://www.online-vba.de/vba_word2xls_tables.php
' Verwendung der Quelltexte auf eigene Gefahr!
' Es gelten die Nutzungsbedingungen von https://www.online-vba.de
' ****************************************************************


Public Sub OVBAde_ExportTablesToExcel()
  Dim oExcelApp As Object
  Dim oExcelWorkbook As Object
  Dim lZeile As Long
  Dim lSpalte As Long
  Dim lTable As Long
  Dim oTable As Object
  Dim lRememberSheetsInNewWorkbook As Long
    
    'Zuerst wird die Excel Datei geöffnet
    Set oExcelApp = CreateObject("Excel.Application")
    
    'Nur ein leeres Blatt beim Anlegen erstellen
    lRememberSheetsInNewWorkbook = oExcelApp.SheetsInNewWorkbook
    oExcelApp.SheetsInNewWorkbook = 1
    Set oExcelWorkbook = oExcelApp.Workbooks.Add
    oExcelApp.SheetsInNewWorkbook = lRememberSheetsInNewWorkbook
    oExcelApp.Visible = True
    
    'Schleife über alle Tabellen des Dokuments
    lTable = 1
    For Each oTable In ActiveDocument.Tables
        
        'Ab der zweiten Tabelle ein weiteres Blatt ergänzen
        If lTable >= 2 Then
            oExcelWorkbook.Sheets.Add After:=oExcelWorkbook.Sheets(oExcelWorkbook.Sheets.Count)
        End If
    
        'Tabelle übertragen für alle Zeilen und Spalten
        For lZeile = 1 To oTable.Rows.Count
            For lSpalte = 1 To oTable.Columns.Count
                'Steuerzeichen abschneiden und Zellenwert übertragen
                oExcelWorkbook.Sheets(lTable).Cells(lZeile, lSpalte) = _
                    Replace(Trim(CStr(oTable.Cell(lZeile, lSpalte).Range.Text)), Chr(13) & Chr(7), "")
            Next lSpalte
        Next lZeile
    
        'Nächste Tabelle und Arbeitsblatt
        lTable = lTable + 1
        
    Next oTable
    
    MsgBox "Fertig!"
    
    'Aufräumen nicht vergessen ...
    Set oTable = Nothing
    Set oExcelWorkbook = Nothing
    Set oExcelApp = Nothing
End Sub

Anmerkungen und Hinweise ...

Dieser Codeschnipsel wurde geschrieben von Marc Wershoven im Jahr 2017.
Es gelten die Nutzungsbedingungen von Online-VBA.de.
TOTOP
ANZEIGE