I insert an image into the specified area (rngOblastVlozeni). But before inserting the image, I want to remove all the images that have been there so far.
I use the following part of VBA to do this:
Dim shpObjekt As Shape
With rngOblastVlozeni.Parent
For Each shpObjekt In .Shapes
If Application.Intersect(shpObjekt.TopLeftCell, rngOblastVlozeni) Is Nothing Then
Else
If (shpObjekt.Type = msoPicture) Or (shpObjekt.Type = msoLinkedPicture) Then
shpObjekt.Delete
End If
End If
Next shpObjekt
End With
But in some cases I receive error
Run-time error '1004':
Application-defined or object-defined error
The error is in the line If Application.Intersect(shpObjekt.TopLeftCell, rngOblastVlozeni) Is Nothing Then , probably in part shpObjekt.TopLeftCell.
When I tried to capture it in more detail:
- I have two pictures and one graph on the sheet
- I insert another image in the designated area
If the area is EMPTY, then two shpObjects will pass without error, and the error will not appear until the third one.
If there IS an image in the area, then three shpObjects are OK, and the error is on the fourth.
When I remove both images and the graph, as well as any image in the area, the error still appears (if there is no image, then as the first shpObject if there is an image, then as the second shpObject) - from this I deduce that the error is not with any of these images .
Could there be more to the Shapes collection? For example, from a previous event?
And if so, can someone advise on adding the code so that I "ignore" the error ONLY in the case of this error and ONLY in this part of VBA, and jump to the Next shpObjekt when it occurs?
One more addition - if I use the absolutely same code on another sheet, it doesn't seem to cause this problem, i.e. it happens without any problems - i.e. it seems that I have some extra object on the problematic sheet, which I am not able to find. I tried F5 - Go to all objects, I deleted them, but the problem was not solved - i.e. it is probably not a visible object?
So, question:
is it possible there is another
Shape Objecton my sheet? Is it possible to identify it somehow?any reccommendation how to skip part
If Application.Intersect(shpObjekt.TopLeftCell, rngOblastVlozeni) Is Nothing Then Else If (shpObjekt.Type = msoPicture) Or (shpObjekt.Type = msoLinkedPicture) Then shpObjekt.Delete End If : End If
in case If Application.Intersect(shpObjekt.TopLeftCell, rngOblastVlozeni) Is Nothing generates error 1004 (optimally ONLY this error)?
Thanks :-)
CodePudding user response：
On your specific two questions:
- I can't say whether there is another Shape in your sheet without having the sheet here in front of me, but you can use
Debug.Printto test (see code below) - Test if shpObjekt and its Address property are not Nothing (again, see code below)
Dim shpObjekt As Shape
With rngOblastVlozeni.Parent
For Each shpObjekt In .Shapes
If Not shpObjekt Is Nothing Then
If Not shpObjekt.TopLeftCell Is Nothing Then
If Application.Intersect(shpObjekt.TopLeftCell, rngOblastVlozeni) Is Nothing Then
Debug.Print "Not intersecting:", shpObjekt.Name, shpObjekt.TopLeftCell.Address, shpObjekt.Type
Else
Debug.Print "Intersecting:", shpObjekt.Name, shpObjekt.TopLeftCell.Address, shpObjekt.Type
If (shpObjekt.Type = msoPicture) Or (shpObjekt.Type = msoLinkedPicture) Then
shpObjekt.Delete
End If
End If
End If
End If
Next shpObjekt
End With
In addition, I think the root cause of the problem you are having is quite likely you are using a For Each to iterate over a Collection (ie of Shapes) while deleting members of that Collection ... it is better to use For Next and loop backwards when deleting ... for this, your code would become
Dim shpObjekt As Shape
Dim index As Long
With rngOblastVlozeni.Parent
For index = .Shapes.Count To 1 Step -1
Set shpObjekt = .Shapes.Item(index)
If Not shpObjekt Is Nothing Then
If Not shpObjekt.TopLeftCell Is Nothing Then
If Application.Intersect(shpObjekt.TopLeftCell, rngOblastVlozeni) Is Nothing Then
Debug.Print "Not intersecting:", shpObjekt.Name, shpObjekt.TopLeftCell.Address, shpObjekt.Type
Else
Debug.Print "Intersecting:", shpObjekt.Name, shpObjekt.TopLeftCell.Address, shpObjekt.Type
If (shpObjekt.Type = msoPicture) Or (shpObjekt.Type = msoLinkedPicture) Then
shpObjekt.Delete
End If
End If
End If
End If
Next index
End With