VBA to copy from Excel as image and paste in Word

[Diag]

Hello,

I am new to the forum and I use VBA not very often. I have used the code (similar to the code mentioned in the link below).

VBA to copy from Excel as image and paste in Word

I found some code that basically does what I need, but I need it to paste in as a picture. What needs to change for that? Thank you for any help! Sub CopyWorksheetsToWord() Dim wdApp As Word.Application, wdDoc As Word.Document, ws As Worksheet Application.ScreenUpdating = False...

www.mrexcel.com

When I use the code it works fine, but I get the popup message that the image is too big and that it will be cut. when viewing the image in word, it is not fitted correctly. My data is in Range A1:O58.

the program I use is:
-------------------------------------------------------------------------------------------------------------------------------------------------------------
Sub SaveXlRangeToWordFile()

Dim ObjPic As Object, Ws As Worksheet
Dim WdDoc As Object, WdApp As Object

'open Word application
On Error Resume Next
Set WdApp = GetObject(, "word.application")
If Err.Number <> 0 Then
On Error GoTo 0
Set WdApp = CreateObject("Word.Application")
End If

'open doc **********change file path to suit
On Error GoTo erfix
Set WdDoc = WdApp.Documents.Open(Filename:="C:\Users\******\********\******\test.docx")
For Each Ws In ActiveWorkbook.Worksheets
Application.StatusBar = "Copying data from " & Ws.Name & "sheets"

Ws.UsedRange.Copy '

WdDoc.Paragraphs(WdDoc.Paragraphs.Count).Range.PasteSpecial DataType:=3 '9 '4
Application.CutCopyMode = False
WdDoc.Paragraphs(WdDoc.Paragraphs.Count).Range.InsertParagraphAfter

If Not Ws.Name = Worksheets(Worksheets.Count).Name Then

With WdDoc.Paragraphs(WdDoc.Paragraphs.Count).Range
.InsertParagraphAfter
.Collapse Direction:=0 'wdCollapseEnd
.InsertBreak Type:=7 'wdPageBreak
End With
End If
Next Ws

'pictures in newxl version are converted to inlineshapes
'takes time to paste and convert
'Application.Wait (Now + TimeValue("0:00:02"))
'For Each ObjPic In WdApp.ActiveDocument.InlineShapes
'ObjPic.ConvertToShape
'Next ObjPic
WdApp.ActiveDocument.Close savechanges:=True
Set WdDoc = Nothing
WdApp.Quit
Set WdApp = Nothing
Application.StatusBar = False
'Set ObjPic = Nothing
Exit Sub

erfix:
On Error GoTo 0
MsgBox "Save SaveXlRangeToWordFile error"
WdApp.ActiveDocument.Close savechanges:=False
Set WdDoc = Nothing
WdApp.Quit
Set WdApp = Nothing
Application.CutCopyMode = False
Application.StatusBar = False
'Set ObjPic = Nothing
End Sub
----------------------------------------------------------------------------------------------------------------------------------
Can someone maybe help me with the program to autofit the picture to word?

Thanks

 

[Diag]

Hi Dave,
Thanks or your reply. I have tried and tested your piece of code. Unfortunately it didnt solve the error.

I get the idea that the chartobject isnt defined correctly (range to copy). I suspect that gives the error "subject out of range"
But not sure how or what. I will investigate this further. is there a proper workaround to use the "copy. Range " function?

Thanks

 

[NdNoviceHlp]

Your copy range can be set like this...

Dim Rng As Range
With ActiveWorkbook.Worksheets(Names)
Set Rng = .Range(.Cells(1, 1), .Cells(iTotalRows, iTotalCols))
End With
Rng.Copy

Dave