VBA Word PDF -Tabelle zu Excel
Sub ImportPDFTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim wrd As Object
Dim ApplicationIsRunning As Object
Dim IsWordRunning As Boolean
Dim TableNo As Integer
Dim iRow As Long, iCol As Integer, iCount As Integer
wdFileName = Application.GetOpenFilename("PDF files,*.pdf,Word files,*.doc*", , _
"Browse for file containing table to be imported")
If wdFileName = False Then Exit Sub '(user cancelled import file browser)
Set wrd = CreateObject("Word.Application")
Set wdDoc = wrd.Documents.Open(wdFileName) 'open PDF file in Word
wrd.Visible = False
wrd.Selection.WholeStory
wrd.Selection.Copy
ActiveSheet.PasteSpecial Format:="Text" 'optional - pastes whole document for easy checking
Range("A1").Select
With wdDoc
TableNo = wdDoc.tables.Count
If TableNo = 0 Then MsgBox "This document contains no tables", vbExclamation, "Import Word Table"
For iCount = 1 To TableNo
Worksheets.Add
'Range("A:M").NumberFormat = "@"
TableNo = iCount
With .tables(TableNo)
'copy cell contents from Word table cells to Excel cells
For iRow = 1 To .Rows.Count
For iCol = 1 To .Columns.Count
On Error Resume Next
Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
Next iCol
Next iRow
End With
Next iCount
End With
Set wdDoc = Nothing
wrd.Quit
Set wrd = Nothing
End Sub
Anxious Alpaca