Insert picture using VBA throws up an error

[chriscorpion786]

Hi All, i have the below code where I am inserting pictures which i have on different sheets in the same workbook. Sometimes, the code works perfectly fine, sometimes it throws up an error at the point of shp.copy.
I cannot debug and try to figure out what is causing the error, everything seems to be fine, should I be using Application.screenupdating = false or is there any bug here.
Kindly advice, my code is as below and I have highlighted in red where the code errors.

Sub SalesDashboard()

Dim cat As String
Dim tbl As ListObject
Dim row As Long, col As Long
Dim shp As Shape



row = 8
col = 2

cat = Application.Caller

Set tbl = Sheet1.ListObjects("EPOS")

With Sheet2

.Range("AA2").Value = .Shapes(cat).TextFrame2.TextRange.Text
.Range("K35").Value = .Shapes(cat).TextFrame2.TextRange.Text
.Range("AN2").Value = .Shapes(cat).TextFrame2.TextRange.Text

tbl.Range.AdvancedFilter xlFilterCopy, criteriarange:=[Category], copytorange:=.Range("AD2:AJ2"), Unique:=False


For Each shp In .Shapes

If InStr(shp.Name, "SKU") Then shp.Delete

Next shp

'Bring in the category pictures

For Each shp In Sheets(.Range("AA2").Value).Shapes

shp.Copy ' this is where it throws an error sometimes

.Paste .Cells(row, col)

With .Shapes(shp.Name)
    .Left = Cells(row, col).Left
    .Top = Cells(row, col).Top
    .LockAspectRatio = msoFalse
    .Width = Cells(row, col).Width
    .Height = Cells(row, col).Height * 5
    .OnAction = "SKUFilter"
End With

.Shapes("Desc").Duplicate.Name = "Desc" & shp.Name
.Shapes("Desc" & shp.Name).TextFrame2.TextRange.Text = Mid(shp.Name, 4, 10)

With .Shapes("Desc" & shp.Name)
    .Left = Cells(row, col).Left
    .Top = Cells(row + 6, col).Top
    .LockAspectRatio = msoFalse
    .Width = Cells(row, col).Width + 10
    .Height = 32
    .OnAction = "SKUFilter"
End With

.Shapes.Range(Array(shp.Name, "Desc" & shp.Name)).Group.Name = shp.Name
.Shapes(shp.Name).OnAction = "SKUFilter"

If col = 8 Then
col = 2
row = row + 10

Else

col = col + 2

End If
Next shp

.Range("K9").Value = Sheet15.Range("E5").Value
.Range("N9").Value = Sheet15.Range("H5").Value

.Range("K16").Value = Sheet15.Range("E6").Value
.Range("N16").Value = Sheet15.Range("H6").Value

.Range("K23").Value = Sheet15.Range("E7").Value
.Range("N23").Value = Sheet15.Range("H7").Value

End With
End Sub

 

[BSALV]

see this post

Error 1004 Randomly

I have a macro that gets launched by a vbs script that i have going so the macro is Sub CB_Hourly() Dim oApp As Object, oMail As Object, FileStr As String Dim NewWb As Workbook, cnt As Integer Dim FileName As String, MailSub As String, MailTxt As String Dim tmpImageName As String...

www.mrexcel.com

you have to delay excel for a very small period, like 500 milliseconds (0.5 sec), just before and after the "paste" and i think "after" is the most critical one.
I think the shape isn't pasted yet and you already try to move it.
If 500 isn't okay, make it 1000, else you can try to decrease to 250 or less.

 

[chriscorpion786]

O.K , i will give it a try and let you know if it works. Thanks.

 

[chriscorpion786]

Hi, I tried using the delay method, it still throws up an error at times...wonder if anyone has a better solution for this.

 

[BSALV]

As i read again your question, the error happens at the line "shp.copy" and i adviced you to add twice a brake-moment around the paste.
Add a 3th brake moment, just in front of the that annoying "copy" and start with 1000.
If everything works without errors, decrement that 1000 to 500, 250, 200, ...
Then try to get ride of the 2nd and/or the 3rd, because perhaps they are not necessary.

Keep in mind that if your processor is doing other stuff at that time (receiving mail, surfing, ...), he 'll be slower at that moment.
So, if after a while you have again such a problem at 50 msec until you work errorfree.

If you like drinking coffee, have 3 of those brakes at 1000 mseconds and live stressfree.

 

[chriscorpion786]

LOL.....excel can be confusing sometimes...I have tried the following: there is a slight delay but will do if it works correctly without the error..

Application.ScreenUpdating = False
shp.Copy
Application.ScreenUpdating = True

Application.ScreenUpdating = False
Sheet2.Paste Sheet2.Cells(row, col)
Application.ScreenUpdating = True

 

[RoryA]

Just on the off chance, do you have any data validation dropdowns on any of the sheets you are copying from?

 

[BSALV]

just to know, was #6 a solution or also a LOL ?

 

[chriscorpion786]

Just on the off chance, do you have any data validation dropdowns on any of the sheets you are copying from?

No, there are no data validation dropdowns, only shapes that use the application.caller method

 

[chriscorpion786]

just to know, was #6 a solution or also a LOL ?

I guess it works, there is no error popping up so far, just a slight delay in response of the shapes getting loaded. Thank you.