VBA copy image from excel sheet to word doc

[simba24d]

Hi all,

I'm trying to copy an image that is present on excel sheet to a word doc.
I know that to copy a chart

With ActiveSheet.ChartObjects(1).Chart
.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
Paste chart
wrdDoc.Paragraphs(wrdDoc.Paragraphs.Count).Range.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, Placement:=wdInLine, DisplayAsIcon:=False
End With

but what about an image (jpg/gif/...) that has been inserted in the active sheet?

Thanks for the support

 

[simba24d]

Anyone can help me?

 

[NdNoviceHlp]

what''s the pic name? Is it a shape? Why not just use the pic file? Where in the Word doc do you want to put it and what do you want to put it in? Dave

 

[simba24d]

Hi,
the picture is a normal jpg. Below you can find the new way that I'm trying to use

ActiveSheet.Shapes(1).Copy
wrdDoc.Paragraphs(wrdDoc.Paragraphs.Count).Range.PasteSpecial Link:=False, DataType:=wdPasteShape, Placement:=wdInLine, DisplayAsIcon:=False

now the problem is that I need to paste the image like microsoft office graphics object. So I need to find the correct DataType. Do you know which could be the right?
Thanks

 

[bjurney]

This code will copy a picture from an Excel Spreadsheet and paste it into a new Word document. Just change "Picture 1" to whatever the name of your picture is.

Sub paste_the_pic()
Dim appwd As Object
       Set appwd = GetObject(, "Word.Application")
       appwd.Visible = True
   appwd.documents.Add
   Worksheets("Sheet1").Shapes("Picture 1").Copy
   appwd.documents.Add
    appwd.Selection.Paste (wdPasteDefault)
End Sub

 

[simba24d]

Hi biurney,

I've already done that in general way and not like "microsoft office graphics object".
I will try to change the strategy.
Thanks a lot for your support

 

[NdNoviceHlp]

'if XL version > 07 pic type
If Application.Version > 12 Then
If ShapeName.Type = 11 Then
'do stuff
End If
Else
If ShapeName.Type = 13 Then
'do stuff
End If
End If

HTH with datatype. Dave

 

[simba24d]

'if XL version > 07 pic type
If Application.Version > 12 Then
If ShapeName.Type = 11 Then
'do stuff
End If
Else
If ShapeName.Type = 13 Then
'do stuff
End If
End If

HTH with datatype. Dave

Thanks.
Do you also know how to perform a resize? I need to copy a group of cells from excel and paste them on word doc like an image using pastespecial but I need to resize the image. Below you can find whay I've done

Dim wrdDoc As Word.Document
vector.Sheets("sheet1").Range("B2:Z40").Select
Selection.Copy
wrdDoc.Paragraphs(wrdDoc.Paragraphs.Count).Range.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, Placement:=wdInLine, DisplayAsIcon:=False

The paste works but the image is too big.
Thanks for the support!

 

[NdNoviceHlp]

HTH. Dave

Sub ChangePicSize()
Dim Wdapp2 As Object, Targetrange As Range
'set xl range
With Sheets("Sheet1")
    Set Targetrange = .Range(.Cells(1, "A"), .Cells(5, "C"))
End With
Targetrange.CopyPicture Appearance:=xlScreen, Format:=CF_BITMAP
'open word file
 On Error GoTo ErFix
 Set Wdapp2 = CreateObject("Word.Application")
 Wdapp2.Documents.Open Filename:="D:\test.docx"
 
 '***CAUTION this CLEARS .doc
 With Wdapp2.activeDocument
 .Range(0, .Characters.Count).Delete
 End With
 'paste pic in doc
 Wdapp2.activeDocument.Content.Paste
 With Wdapp2.activeDocument.inlineshapes(1)
 .LockAspectRatio = msoTrue
 .Width = 500
 '.Height = 100
 End With
 'close and save doc
 Wdapp2.activeDocument.Close savechanges:=True
 Wdapp2.Quit
 Set Wdapp2 = Nothing
 Application.CutCopyMode = False
 Exit Sub

ErFix:
On Error GoTo 0
MsgBox "Save to file error"
Wdapp2.activeDocument.Close savechanges:=False
Wdapp2.Quit
Set Wdapp2 = Nothing
Application.CutCopyMode = False
End Sub

 

[imskin]

What if i have two picture and two chart in the sheet. How can copy all of this into words?