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

13,977

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!

Share:
13,977
Rafael
Author by

Rafael

Regularly getting in trouble by suggesting "wouldn't there be a way to get this done easier through VBA" to my boss. Actually not knowing a thing about programming, but most of the times getting away with putting together bits of this and that and receiving the help of great people on the internet.

Updated on June 04, 2022

Comments

  • Rafael
    Rafael almost 2 years

    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