Option Explicit
Enum WdUnits
wdCharacter = 1
End Enum
Enum WdOLEPlacement
wdFloatOverText = 1
wdInLine = 0
End Enum
Enum WdPasteDataType
wdPasteBitmap = 4
wdPasteDeviceIndependentBitmap = 5
wdPasteEnhancedMetafile = 9
wdPasteHTML = 10
wdPasteHyperlink = 7
wdPasteMetafilePicture = 3
wdPasteOLEObject = 0
wdPasteRTF = 1
wdPasteShape = 8
wdPasteText = 2
End Enum
Sub NachWordUebertragen()
Dim appWord As Object
Dim Report As Object
Dim obj As Object
Set appWord = ...
Set Report = ...
Report.Bookmarks("Vorname").Range.Text = Range("Vorname")
If Report.Bookmarks.Exists("BKName_Chart") Then
Set obj = Report.Bookmarks("BKName_Chart").Range
Call Shapes(1).Copy
Call obj.PasteSpecial(Placement:=WdOLEPlacement.wdInLine, _
DataType:=WdPasteDataType.wdPasteMetafilePicture, _
DisplayAsIcon:=False)
Call obj.MoveStart(Unit:=WdUnits.wdCharacter, Count:=-1)
Set obj = obj.InlineShapes(1)
End If
End Sub