Home > Mobile >  Excel VBA - 1004 Error code when removing picture from excel sheet
Excel VBA - 1004 Error code when removing picture from excel sheet

Time:11-15

I have a made a VBA based complaints form that keeps track of a number of details about a complain. One feature that i added lately is that it is now possible to add a picture to the report/form.

When the form is submitted all the filled cells are copied to a seperate spreadsheet and the form itself needs to wiped and the pictures need to be removed so that a new report can be filled if neccessary. It is like a reset.

In order to remove the pictures I copied the below piece of script. About 90% of the time it works perfectly fine and the images are removed and the form is back to it's original form however every once in a while for unknown reason i get a Error 1004 "Application Defined or Object Defined Error". When i receive this error i am unable to remove the pictures and need to restart the excel file.

Within VBA highlighted in yellow it says that the k.TopLeftCell is the cause of it.

With Sheets("Klachtformulier")
  Dim k As Shape, rng As Range
    Set rng = Sheets("Klachtformulier").Range("A43:H47")
    For Each k In ActiveSheet.Shapes
     If Intersect(k.TopLeftCell, rng) Is Nothing Then
        Else
            k.Delete
        End If
    Next k

I tried to change activesheets to the sheet("name"), tried change the range, tried to change shape dim into a picture dim and tried to exit the for after one loop however all without succes so far. Most of the time these changes cause the pictures from not being removed anymore.

Any idea what could be the cause or the solution?

CodePudding user response:

I think the problem is likely that you are deleting members of a collection (the Shapes collection) while iterating over it using 'For ... Each'. When deleting, you should use 'For ... Next' and loop from the end of the collection to the start:

Dim k As Shape, rng As Range
Dim i As Long
Set rng = Sheets("Klachtformulier").Range("A43:H47")
For i = ActiveSheet.Shapes.Count To 1 Step -1
  Set k = ActiveSheet.Shapes.Item(i)
  If Not Intersect(k.TopLeftCell, rng) Is Nothing Then
        k.Delete
    End If
Next i

I tweaked the logic of your If statement and removed the With line as (in the code you posted) it isn't doing anything useful.

  • Related