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

[ashish128]

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.

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

 

[rlv01]

What if you used the copy command instead of cut?

    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?

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

 

[Fluff]

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.

 

[ashish128]

What if you used the copy command instead of cut?

    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?

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

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.

 

[ashish128]

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

 

[ashish128]

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.

Thanks for letting me know.

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

 

[Fluff]

That link works for me Excelguru Help Site - A message to forum cross posters
Maybe they were having problems when you tried.

 

[rlv01]

That link works for me Excelguru Help Site - A message to forum cross posters

Works for me too.

 

[ashish128]

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.

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

BTW the real solution to my problem was to add

Application.CutCopyMode = False

making it

Application.CutCopyMode = False
picobject.Cut
TargetCell.PasteSpecial

Now it is working.