VBA copying Excel chart to Word as picture changes the chart size

Question

I want to create a macro that copies charts from Excel and pastes them into Word as pictures (preferrably Enhanced Metafiles).

I set up a Word template document with a table which contains bookmarks in specific cells where the pictures should be inserted.

With my current code, however, the inserted image is way too big and screws up the whole table. I tried different picture options (enhanced metafile, png, etc.), but they all have the same result.

When I try to copy the chart by hand using PasteSpecial in the table, it keeps the orginal size which is just how I want it.

What do I have to change in my code to get that?

Sub CopyCharts2Word()

Dim wd As Object
Dim ObjDoc As Object
Dim FilePath As String
Dim FileName As String
FilePath = "C:\Users\Name\Desktop"
FileName = "Template.docx"


'check if template document is open in Word, otherwise open it
On Error Resume Next
Set wd = GetObject (, "Word.Application")    
If wd Is Nothing Then
    Set wd = CreateObject("Word.Application")
    Set ObjDoc = wd.Documents.Open(FilePath & "\" & FileName)
Else
    On Error GoTo notOpen
    Set ObjDoc = wd.Documents(FileName)
    GoTo OpenAlready
notOpen:
    Set ObjDoc = wd.Documents.Open(FilePath & "\" & FileName)
End If
OpenAlready:
On Error GoTo 0

'find Bookmark in template doc 
wd.Visible = True                                              
ObjDoc.Bookmarks("Boomark1").Select  

 'copy chart from Excel        
 Sheets("Sheet1").ChartObjects("ChartA").chart.ChartArea.Copy        

 'insert chart to Bookmark in template doc
 wd.Selection.PasteSpecial Link:=False, _
 DataType:=wdPasteMetafilePicture, _
 Placement:=wdInLine, _
 DisplayAsIcon:=False

 End Sub

Answer 1

Rafael thank you. I used some part of your solution. My problem was bookmarking when i created new word document from excel. And i didnt find better solution for bookmark so i looked different sites and This is my solution ( Thanks to all answers from different web sites and Stackoverflow)

Sub Kpyla_Click()

Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdRng As Word.Range
Dim crt As Object
Dim pic As Word.Shape
Dim ust As Word.Range

Kpyla.Caption = "E->W"
Kpyla.Font.Size = 14
Kpyla.Height = 25
Kpyla.Width = 40
Kpyla.Top = 60
Kpyla.Left = 180
Kpyla.Visible = True

On Error GoTo ErrHandler1
Set crt = ActiveSheet.ChartObjects(1)
MsgBox ("Active Chart")
crt.Activate

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")

If wdApp Is Nothing Then
    MsgBox ("Creating New")
    Set wdApp = New Word.Application
    Set wdDoc = wdApp.Documents.Add
Else
    MsgBox ("Active")
    Set wdDoc = wdApp.ActiveDocument
End If

wdApp.Visible = True

With wdDoc.PageSetup
    .Orientation = wdOrientLandscape
    .TopMargin = wdApp.InchesToPoints(0.25)
    .BottomMargin = wdApp.InchesToPoints(0.25)
    .LeftMargin = wdApp.InchesToPoints(0.25)
    .RightMargin = wdApp.InchesToPoints(0.25)
    .HeaderDistance = wdApp.InchesToPoints(1)
    .FooterDistance = wdApp.InchesToPoints(1)
End With
Set ust = wdDoc.Sections.Item(1).Headers(wdHeaderFooterPrimary).Range
ust.Text = "" & vbNewLine

With wdApp.Selection
    .ParagraphFormat.Alignment = wdAlignParagraphCenter
End With

crt.Chart.ChartArea.Copy

Set wdRng = wdDoc.ActiveWindow.Selection.Range
wdRng.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, Placement:=wdTight, DisplayAsIcon:=True

wdDoc.Content.Select '''/

With wdApp.Selection
    .Collapse Direction:=0
    .InsertBreak Type:=7
End With

MsgBox ("Ending")
Exit Sub

ErrHandler1: MsgBox ("No Chart") Exit Sub
End Sub

Answer 2

Yep, that's it:

I replaced

'insert chart to Bookmark in template doc
wd.Selection.PasteSpecial Link:=False, _
DataType:=wdPasteMetafilePicture, _
Placement:=wdInLine, _
DisplayAsIcon:=False

with

wd.Selection.PasteSpecial Link:=False, _
DataType:=wdPasteMetafilePicture, _
Placement:=wdTight, _    
DisplayAsIcon:=False

This way, the size of the Chart remains the same as in the Excel sheet!