Copy Range and Paste to Word as Picture Error

Dresden

New Member
Joined
Jul 22, 2016
Messages
4
Hello,

This is a great website and resource and I wanted to thank everyone for their contributions. I am receiving a run-time error 1004 "CopyPicture method of range failed" when trying to run a macro multiple times. From internet research I created a macro to copy a range of cells and paste the data to Word as a picture. The code also opens a template word document to do this and then saves the file as a specific name. The macro will work some of the time and then out of nowhere I will get the error. Using Debug will point specifically to "Sheets("New Form").Range("$A$1:$J$51").CopyPicture". Can anyone help me fix the coding to resolve the error that I receive?

Code:
Sub CapitalAccountStatements()




Dim objWord


Dim objDoc


Dim objSelection




Set objWord = CreateObject("Word.Application")


'Template Location
   Set objDoc = objWord.Documents.Open("C:\Users\jlichtman\Desktop\Temp Print\Test\Copy to Word\Test Word.docx")




   objWord.Visible = True
   
'Copy Range & Paste
   
   Sheets("New Form").Select
   Sheets("New Form").Range("$A$1:$J$51").CopyPicture


   Set objSelection = objWord.Selection
   objSelection.TypeParagraph
   objSelection.Paste


'Save As Sourcing


Dim FName           As String
Dim FPath           As String
     
    FPath = Sheets("New Form").Range("M7").Text
    FName = Sheets("New Form").Range("M6").Text




   objDoc.SaveAs Filename:=FPath & "\" & FName
   
   


objWord.Quit



End Sub
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Can be the memory issue.
To release the clipboard's memory add this line of the code below the objSelection.Paste :
Application.CutCopyMode = False
 
Upvote 0
Please try the below code with correct releasing memory of all object variables:

Rich (BB code):

Sub CapitalAccountStatements()
 
  ' Template Location
  Const TEMPLATE = "C:\Users\jlichtman\Desktop\Temp Print\Test\Copy to Word\Test Word.docx"
 
  Dim objWord As Object
  Dim objDoc As Object
  Dim objSelection As Object
  Dim FName As String
  Dim FPath As String
 
  ' Try using of already open Word object or create the new one
  On Error Resume Next
  Set objWord = GetObject(, "Word.Application")
  If Err Then Set objWord = CreateObject("Word.Application")
  objWord.Visible = True
  On Error GoTo 0
 
  'Open the Template Document
  Set objDoc = objWord.Documents.Open(TEMPLATE)
 
  ' Copy Range as Picture
  Sheets("New Form").Select
  Sheets("New Form").Range("$A$1:$J$51").CopyPicture
 
  ' And paste it into Woprd's template
  Set objSelection = objWord.Selection
  objSelection.TypeParagraph
  objSelection.Paste
 
  ' Release the memory of Excel clipboard
  Application.CutCopyMode = False
 
  'Save As Sourcing
  FPath = Sheets("New Form").Range("M7").Text
  FName = Sheets("New Form").Range("M6").Text
  objDoc.SaveAs Filename:=FPath & "\" & FName
 
  ' Close the document and release memory of the object variables in child-to-parent sequence
  Set objSelection = Nothing
  objDoc.Close False
  Set objDoc = Nothing
 
  ' Quit Word and release its memory
  objWord.Quit
  Set objWord = Nothing
 
End Sub

Please post the debugger warning message if error still exists.
Does error happens always or only after some good executing?
 
Last edited:
Upvote 0
I tried the code you referenced and the results were the same. The error occurs after some good executing. It does not happen every time.

Error:
Run-Time error '1004':
CopyPicture method of Range Class failed

It highlights the following piece of code: Sheets("New Form").Range("$A$1:$J$51").CopyPicture

I appreciate the help.
 
Upvote 0
The reason of the problem can be in clipboard hacking by Excel AddIns or other applications.
1. Try to clear clipboard via Application.CutCopyMode = False also before objSelection.Paste
2. In Excel disable all AddIns especially COM AddIns (Adobe and so on)
3. Temporary stop/disable all clipboard hacking application and toolbars.
4. Close as much as possible active applications and Internet explorers and then run Excel & Word only.
 
Upvote 0
The problem still exists on an intermittent basis. Clearing the clipboard, disabling all macros, and closing all applications but word/excel does not resolve the issue. Is there a way to implement coding that repeats the CopyPicture line if an error 1004 occurs? I'm not sure if this would resolve the reason behind the problem but may provide a workaround.
 
Upvote 0
...Is there a way to implement coding that repeats the CopyPicture line if an error 1004 occurs? I'm not sure if this would resolve the reason behind the problem but may provide a workaround.
Try this code:
Rich (BB code):
Sub CapitalAccountStatements()
 
  '--> User Settings
  Const TEMPLATE = "C:\Users\jlichtman\Desktop\Temp Print\Test\Copy to Word\Test Word.docx" ' Template Location
  Const TIMEOUT = 0.1 ' Seconds between repeating of CopyPicture
  Const ATTEMPTS = 10 ' Attempts of CopyPicture repeating
  '<-- End of User Settings
 
  Dim objWord As Object
  Dim objDoc As Object
  Dim objSelection As Object
  Dim FName As String
  Dim FPath As String
  Dim IsNew As Boolean  ' Flag of creating the new Word instance
  Dim t As Single
  Dim i As Long
 
  ' Try using of already open Word object or create the new one
  On Error Resume Next
  Set objWord = GetObject(, "Word.Application")
  If Err Then
    IsNew = True
    Set objWord = CreateObject("Word.Application")
  End If
  objWord.Visible = True
  On Error GoTo 0
 
  'Open the Template Document
  Set objDoc = objWord.Documents.Open(TEMPLATE)
 
  ' Copy Range as Picture
  On Error Resume Next
  With Sheets("New Form").Range("$A$1:$J$51")
    For i = 1 To ATTEMPTS
      ' Clear the clipboard
      Application.CutCopyMode = False
      DoEvents
      ' Try to copy picture (arguments xlScreen, xlBitmap are more safety for that)
      .CopyPicture xlScreen, xlBitmap
      ' Wait TIMEOUT seconds
      If Err Then
        Err.Clear
        t = Timer + TIMEOUT
        While Timer < t
          DoEvents
        Wend
      Else
        ' Don't waste time if not Err
        Exit For
      End If
    Next
  End With
  If Err Then
    ' Inform & exit if error was not resolved
    MsgBox "Issue with CopyPicture method", vbCritical, "Exit"
    Exit Sub
  End If
  On Error GoTo 0
 
  ' Paste into Word's template
  Set objSelection = objWord.Selection
  objSelection.TypeParagraph
  objSelection.Paste
 
  ' Release the memory of Excel clipboard
  Application.CutCopyMode = False
  DoEvents
  
  'Save As Sourcing
  FPath = Sheets("New Form").Range("M7").Text
  FName = Sheets("New Form").Range("M6").Text
  objDoc.SaveAs Filename:=FPath & "\" & FName
 
  ' Close the document and release memory of the object variables in child-to-parent sequence
  Set objSelection = Nothing
  objDoc.Close False
  Set objDoc = Nothing
 
  ' Quit Word and release its memory
  If IsNew Then objWord.Quit
  Set objWord = Nothing
 
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,986
Members
448,538
Latest member
alex78

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top