Need help resolving an inconsistent runtime 1004 error when deleting pictures.

[karamarrott]

I have a report that needs pictures imported regularly. I have a Macro that will delete the pictures in a column and then import new ones. However, using the button back to back will eventually give an error of "1004 Unable to get TOPLEFTCELL properly of picture class."

Is there a way to rewrite the picture delete VBA or some kind of error in the code?

Set xRg = Range("AZ3:AZ14")
    For Each xPic In ActiveSheet.Pictures
    
        Set xPicRg = Range(xPic.TopLeftCell.Address & ":" & xPic.BottomRightCell.Address)
        If Not Intersect(xRg, xPicRg) Is Nothing Then xPic.Delete
        Next
On Error Resume Next

Also I have version 2019 while others that use the file have 365 could this cause an issue?

Thank you

 

[NdNoviceHlp]

Hi karamarrott and Welcome to the Board. You can trial this code. Please keep a backup copy of your wb before trialing. Adjust the sheet name to suit. HTH. Dave

Dim Sh As Shape
With Sheets("Sheet1")
For Each Sh In .Shapes
If Application.Version > 12 Then
If Sh.Type = 11 Then
Sh.Delete
End If
Else
If Sh.Type = 13 Then
Sh.Delete
End If
End If
Next Sh
End With

 

[karamarrott]

Hi karamarrott and Welcome to the Board. You can trial this code. Please keep a backup copy of your wb before trialing. Adjust the sheet name to suit. HTH. Dave

Dim Sh As Shape
With Sheets("Sheet1")
For Each Sh In .Shapes
If Application.Version > 12 Then
If Sh.Type = 11 Then
Sh.Delete
End If
Else
If Sh.Type = 13 Then
Sh.Delete
End If
End If
Next Sh
End With

Yes, that worked nice, however, can I make it specific to a range on that sheet?

 

[karamarrott]

Yes, that worked nice, however, can I make it specific to a range on that sheet?

Hi BTW and thanks for the welcome

 

[NdNoviceHlp]

I'm not sure... I have never tried. Maybe trial...

With Sheets("Sheet1").Range("AZ3:AZ14")

I'd be interested to know the outcome. Dave

 

[karamarrott]

I'm not sure... I have never tried. Maybe trial...

With Sheets("Sheet1").Range("AZ3:AZ14")

I'd be interested to know the outcome. Dave

Yes, I did try that actually, and i get a

 

[NdNoviceHlp]

Nothings ever easy. Maybe..

Dim Sh As Shape
With Sheets("Sheet1")
For Each Sh In .Shapes
If Not Application.Intersect(Sh.TopLeftCell, .Range("AZ3:AZ14")) Is Nothing Then
    If Application.Version > 12 Then
        If Sh.Type = 11 Then
        Sh.Delete
        End If
    Else
        If Sh.Type = 13 Then
        Sh.Delete
        End If
    End If
End If
Next Sh
End With

Dave

 

[karamarrott]

Nothings ever easy. Maybe..

Dim Sh As Shape
With Sheets("Sheet1")
For Each Sh In .Shapes
If Not Application.Intersect(Sh.TopLeftCell, .Range("AZ3:AZ14")) Is Nothing Then
    If Application.Version > 12 Then
        If Sh.Type = 11 Then
        Sh.Delete
        End If
    Else
        If Sh.Type = 13 Then
        Sh.Delete
        End If
    End If
End If
Next Sh
End With

Dave

Oh, you are the best! I was trying to put those together and just couldn't get it right. But yours worked perfectly!! thank you!

 

[NdNoviceHlp]

You are welcome. Thanks for posting your outcome. Dave

 

[Peter_SSs]

Oh, you are the best! I was trying to put those together and just couldn't get it right. But yours worked perfectly!! thank you!

The marked solution has been changed accordingly. In your future questions, please mark the post as the solution that actually answered your question, instead of your feedback message as it will help future readers. No further action is required for this thread.