Excel VBA, Randon error of <Range>.pastespecial failed

A

ashish128

New Member
Joined
Apr 6, 2016
Messages
21
Office Version
  1. 2019
Platform
  1. Windows
Dear All,

Am calling a function from a sub by passing a string (picture path) and a range variable (Cell address).

The function then inserts the picture and pasts it over range

Issue: The function gives 1004 error on <range>.pastespecial command but not every time. and pressing F5 in debug mode make it run again till next error.

Kindly guide if there is some coding error or Logical error

Application:
In B Column, there are some image path. say from B2 to B6.
select B1 to make it active cell and call macro which will loop till B6.
Pictures will be pasted on Column A for each respective row.

VBA Code: 
Sub Insert_image_on_left()
   Dim i As Long
   Dim intRowCount As Integer
   Dim Image As String
   Dim X As Integer
   Dim Y As String
   Dim p As Object
   Dim col_selected As Integer
  
   Application.ScreenUpdating = False
  
   If ActiveCell.Text = "" Then Exit Sub
  
   image_col = ActiveCell.Column - 1
   last_row = ActiveCell.End(xlDown).Row
   ActiveCell.Offset(0, -1).ColumnWidth = 50
   ActiveCell.Offset(0, -1).RowHeight = 130
   For i = ActiveCell.Row To last_row

       Cells(i, image_col).RowHeight = 150
       Call InsertPictureinCell(Cells(i, image_col + 1).Text, ActiveSheet.Cells(i, image_col))
              
   Next i
   Application.ScreenUpdating = True
  
End Sub

Sub InsertPictureinCell(PictureFileName As String, TargetCell As Range)
' inserts a picture at the top left position of TargetCell

   Dim picobject As Object, t As Double, l As Double, w As Double, h As Double
   Dim PicWtoHRatio As Single
   Dim CellWtoHRatio As Single
  
   If PictureFileName = "" Then Exit Sub
   If Dir(PictureFileName) = "" Then Exit Sub
   Set picobject = thisworkbook.ActiveSheet.Pictures.Insert(PictureFileName)
            
   picobject.Cut
   TargetCell.PasteSpecial '<< This line gives random error of 1004 method of range class failed.
      
   Set picobject = Nothing
End Sub
 

Attachments

  • Image 030.png
    Image 030.png
    5.8 KB · Views: 19
  • Image 029.png
    Image 029.png
    5.9 KB · Views: 72

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Sort by date Sort by votes
What if you used the copy command instead of cut?

VBA Code: 
    picobject.Copy
    TargetCell.PasteSpecial '<< This line gives random error of 1004 method of range class failed.
    picobject.Delete


Or what if you changed the code to insert the picture exactly where you want it without having to use cut and paste?

VBA Code: 
Sub InsertPictureinCell(PictureFileName As String, TargetCell As Range)
    ' inserts a picture at the top left position of TargetCell
    
    Dim picobject As Object, t As Double, l As Double, w As Double, h As Double
    Dim PicWtoHRatio As Single
    Dim CellWtoHRatio As Single
    Dim SaveActiveCell As Range
    
    If PictureFileName = "" Then Exit Sub
    If Dir(PictureFileName) = "" Then Exit Sub
    
    Set SaveActiveCell = ActiveCell
    TargetCell.Select
    Set picobject = ThisWorkbook.ActiveSheet.Pictures.Insert(PictureFileName)
    Set picobject = Nothing
    SaveActiveCell.Select
End Sub
 
Upvote 0
Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Random error of Range.pastespecial fail
also Random error of range.pastespecial - OzGrid Free Excel/VBA Help Forum
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
 
Upvote 0
rlv01 said:
What if you used the copy command instead of cut?

VBA Code: 
    picobject.Copy
    TargetCell.PasteSpecial '<< This line gives random error of 1004 method of range class failed.
    picobject.Delete


Or what if you changed the code to insert the picture exactly where you want it without having to use cut and paste?

VBA Code: 
Sub InsertPictureinCell(PictureFileName As String, TargetCell As Range)
    ' inserts a picture at the top left position of TargetCell
   
    Dim picobject As Object, t As Double, l As Double, w As Double, h As Double
    Dim PicWtoHRatio As Single
    Dim CellWtoHRatio As Single
    Dim SaveActiveCell As Range
   
    If PictureFileName = "" Then Exit Sub
    If Dir(PictureFileName) = "" Then Exit Sub
   
    Set SaveActiveCell = ActiveCell
    TargetCell.Select
    Set picobject = ThisWorkbook.ActiveSheet.Pictures.Insert(PictureFileName)
    Set picobject = Nothing
    SaveActiveCell.Select
End Sub
Click to expand...
Using Copy command had no effect on error. It was same as before.

I tried using your suggested code to insert picture directly but for some reason there was no error and no picture was inserted. I tried to debug but all went smooth without the actual picture showing up in cell.
 
Upvote 0
Below code by Yongle worked for me

Link: Using VBA to insert a picture into a cell

Sub InsertPictureinCell(PictureFileName As String, TargetCell As Range)
' inserts a picture at the top left position of TargetCell

Dim pi As Object, t As Double, l As Double, w As Double, h As Double
Dim PicWtoHRatio As Single
Dim CellWtoHRatio As Single

Set imagecell = TargetCell.MergeArea
Set picobject = ActiveSheet.Pictures.Insert(PictureFileName)
With picobject
.ShapeRange.LockAspectRatio = msoFalse
.Left = imagecell.Left
.Top = imagecell.Top
.Width = imagecell.Width - 10
.Height = imagecell.Height - 10
End With
End Sub
 
Upvote 0
Fluff said:
Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Random error of Range.pastespecial fail
also Random error of range.pastespecial - OzGrid Free Excel/VBA Help Forum
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
Click to expand...
Thanks for letting me know.

Also, the ExcelGuru link in rule #13 has gone Bad. it gives "Forbidden" message.
 

Attachments

  • Image 036.png
    Image 036.png
    16.5 KB · Views: 13
Upvote 0
ashish128 said:
Dear All,

Am calling a function from a sub by passing a string (picture path) and a range variable (Cell address).

The function then inserts the picture and pasts it over range

Issue: The function gives 1004 error on <range>.pastespecial command but not every time. and pressing F5 in debug mode make it run again till next error.

Kindly guide if there is some coding error or Logical error

Application:
In B Column, there are some image path. say from B2 to B6.
select B1 to make it active cell and call macro which will loop till B6.
Pictures will be pasted on Column A for each respective row.

VBA Code: 
Sub Insert_image_on_left()
   Dim i As Long
   Dim intRowCount As Integer
   Dim Image As String
   Dim X As Integer
   Dim Y As String
   Dim p As Object
   Dim col_selected As Integer
 
   Application.ScreenUpdating = False
 
   If ActiveCell.Text = "" Then Exit Sub
 
   image_col = ActiveCell.Column - 1
   last_row = ActiveCell.End(xlDown).Row
   ActiveCell.Offset(0, -1).ColumnWidth = 50
   ActiveCell.Offset(0, -1).RowHeight = 130
   For i = ActiveCell.Row To last_row

       Cells(i, image_col).RowHeight = 150
       Call InsertPictureinCell(Cells(i, image_col + 1).Text, ActiveSheet.Cells(i, image_col))
             
   Next i
   Application.ScreenUpdating = True
 
End Sub

Sub InsertPictureinCell(PictureFileName As String, TargetCell As Range)
' inserts a picture at the top left position of TargetCell

   Dim picobject As Object, t As Double, l As Double, w As Double, h As Double
   Dim PicWtoHRatio As Single
   Dim CellWtoHRatio As Single
 
   If PictureFileName = "" Then Exit Sub
   If Dir(PictureFileName) = "" Then Exit Sub
   Set picobject = thisworkbook.ActiveSheet.Pictures.Insert(PictureFileName)
           
   picobject.Cut
   TargetCell.PasteSpecial '<< This line gives random error of 1004 method of range class failed.
     
   Set picobject = Nothing
End Sub
Click to expand...
BTW the real solution to my problem was to add

VBA Code: 
Application.CutCopyMode = False

making it

Code: 
Application.CutCopyMode = False
picobject.Cut
TargetCell.PasteSpecial

Now it is working.
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

G
  • Solved
Run-Time Error 381
2
Replies
12
Views
201
Micron
M
B
  • Question Question
VBA exports worksheet from XLSM to XLXS matching all source properties doesn't keep print area
Replies
0
Views
128
brentcole
B
A
  • Solved
VBA Case Error
Replies
2
Views
65
Ark68
A
A
  • Question Question
Looking for help in Excel Macros scripts
Replies
0
Views
100
Adnan199
A
A
  • Question Question
Counta Of Filtered Data - Errors In VBA Formula (Poor adaptation)
Replies
4
Views
62
Skyybot
Skyybot

Forum statistics

Threads
1,224,814
Messages
6,181,124
Members
453,021
Latest member
Justyna P

Share this page

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