CODEWITHSUNDEEP
excelvbachartsms-word
PLL
PLL

Reputation: 47

Copying Excel Chart as a picture into Word Table

Having looked at a number of posts about copying an Excel Chart into a Word document I still cannot get a simple piece of code to work.

I have a workbook that has charts on various worksheets. I am sure I can work out code that will work through the looping issue eventually. Right now I just need code that will copy a chart on one sheet into a Word Table, particular cell.

The word document opens, and I can even see that my code has selected the cell.

I developed the copied code from recording a macro, but of course that is only the copying bit I think as the record function does not record outside of Excel.

My ultimate solution is to have the chart copied as a picture into the Word table. And I need a picture, not a link etc.

My code is:

'''

' Trial copy

'xwkBook = ActiveWorkbook.FullName
Sheets(sheetnames(1)).Select
ActiveSheet.ChartObjects("Chart 2").Activate
ActiveChart.ChartArea.Copy
'ActiveChart.ChartArea.CopyPicture xlScreen, xlPicture


    With d
        d.Tables(2).Cell(1, 1).Range.Select
        d.Tables(2).Cell(1, 1).Range.Paste
       
              
    End With

'''

d is defined as

Dim d As Word.Document

and is set through the Word file opening process as Set d = objW.Documents.Open(strFile)

and objW as

Dim objW As Word.Application

As you can I have tried several options, but I do not get anything pasted into the word table. Yes, Tables(2) does exist in my word file.

Upvotes: 1

Views: 133

Answers (1)

taller
taller

Reputation: 18778

Your code logic is close to working. Range.Paste will create a linked object. You can get a image in Word table with PasteSpecial.

    'xwkBook = ActiveWorkbook.FullName
    Set d = ActiveDocument
    
    Dim h As Single, w As Single, img, ratio
    With d.Tables(2).Cell(2, 1).Range
        ' Get the size of cell before pasting
        h = .Rows(1).Height
        w = .Columns(1).Width
        .Select
        Selection.PasteSpecial Link:=False, DataType:=15, Placement:=wdInLine, _
            DisplayAsIcon:=False
        Set img = .InlineShapes(1)
        ' get the shrink ratio
        ratio = IIf((h / img.Height) < (w / img.Width), h / img.Height, w / img.Width)
        ' resize image to fit cell
        img.Height = img.Height * ratio
    End With

Please refer to

Selection.PasteSpecial method (Word)

Upvotes: 2

Related Questions