Sub Word_aktualisieren()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim wdName As Object
Dim objPic As Word.InlineShape
Dim ils As Word.InlineShape
Dim n As Long
Dim i As Integer
Set wbBook = ThisWorkbook
Set wdName = wbBook.Worksheets("Deckblatt").Range("C4")
Set wdApp = New Word.Application
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Open(wbBook.Path & wdName.Value)
For Each objPic In wdDoc.InlineShapes
objPic.Delete
Next objPic
i = 1
Do While i < 17
wbBook.Names("Tabelle_" & i).RefersToRange.Copy
n = wdDoc.InlineShapes.Count
wdDoc.Bookmarks("Tabelle_" & i).Range.PasteSpecial Placement:=wdInLine, DataType:=wdPasteEnhancedMetafile
Set ils = wdDoc.InlineShapes(n + 1)
ils.ScaleHeight = 68
ils.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
i = i + 1
Loop
With wdDoc
.Save
.Close
End With
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
End Sub