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 Object on 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 :-)
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.Print to 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
Related
Can anyone advise on how to handle a "no cells were found" error with the following code. This is a part of a larger sub that may often return no values, however handling the error as follows (which works for many of my other scenarios) still returns "Run-time error '1004': No cells were found". What am I doing wrong?
On Error GoTo Error_Exit_3
Range("Q:Q").SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete
Error_Exit_3:
What I Would do:
Dim RowsWithFormulas As Long
On Error Resume Next
RowsWithFormulas = Range("Q:Q").SpecialCells(xlCellTypeFormulas, 16).Rows.Count
On Error GoTo 0
If RowsWithFormulas > 0 Then
Range("Q:Q").SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete
End If
You can also set this as a Range:
Sub t()
Dim cellsWithErroringFormulas As Range
On Error Resume Next
Set cellsWithErroringFormulas = Range("Q:Q").SpecialCells(xlCellTypeFormulas, 16)
On Error GoTo 0
If cellsWithErroringFormulas Is Nothing Then
' Do whatever
MsgBox ("No formulas result in an error!")
Exit Sub
ElseIf cellsWithErroringFormulas.Rows.Count > 0 Then
cellsWithErroringFormulas.SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete
' Now, if you call `cellsWithErroringFormulas` again, it will error since you removed all those references.
' So to be explicit, let's clear that variable.
Set cellsWithErroringFormulas = Nothing
End If
End Sub
I tweaked the variable name, just because you're not technically looking for rows with formulas, but rather cells with formulas that result in an error. It's a little clunky here, so rename as desired. Just wanted to point that out.
Also, since I don't know what you plan on doing next, I added the Set cellsWithErroringFormulas = Nothing, since we can't use that reference after you delete the erroring rows. You may not need that, but I just wanted to include to point that out also.
Please check the link below. its already answered in this forum.
Also, Please visit the rules for this forum.. :)
1004 Error: No cells were found, easy solution?
When using Range.SpecialCells with a range that doesn't contain cells that match the criteria an error is thrown saying that no cells were found.
The most common solution to this issue is letting it happen and using an error handler to deal with it.
Is that the best known way to solve it or is there other solutions that might be as good or better which avoid using an error handler?
The only thing I can think of would be saving the first cell's value, then changing its value to one that matches the criteria so it avoids the error making it always match at least that one cell, then change the value back to its original value and check the matched range's address to see if it matched that one cell only or more.
A bad/slow solution would be to not make use of it at all and just use loops with checks.
Here's some simple sample code to demostrate a little how it works with the error handler:
Private Sub Procedure()
Dim OriginalRange As Excel.Range
Dim NewRange As Excel.Range
Set OriginalRange = ThisWorkbook.Worksheets(1).Range("A1:C4")
On Error GoTo ErrorHandler
Set NewRange = OriginalRange.SpecialCells(Type:=Excel.XlCellType.xlCellTypeConstants, Value:=Excel.XlSpecialCellsValue.xlNumbers)
Exit Sub
ErrorHandler:
If (VBA.Err.Number <> 1004) Then VBA.Err.Raise VBA.Err.Number
End Sub
Yes it is perfectly normal (I prefer this way) to use the error handler. What I do is, I sandwhich it between On Error Resume Next and On Error GoTo 0 and then check If NewRange is Nothing
See this example
On Error Resume Next
Set NewRange = OriginalRange.SpecialCells(Type:=Excel.XlCellType.xlCellTypeConstants, _
Value:=Excel.XlSpecialCellsValue.xlNumbers)
On Error GoTo 0
If NewRange Is Nothing Then
MsgBox "Your message here informing the USER that desired cells were not found"
Else
'
'~~> Do whatever you want with the range
'
End If
I have looked online as much as I could (except for the Microsoft support website, which is blocked at work for some reason). I am trying to simply skip an error. My code written here is simplified but should work the same way.
What my code is supposed to do:
One of my subs creates shapes in a loop and names them (btn_1, btn_2, etc). But before creating them, it calls a sub that tries to delete them so as not to create duplicates. This sub loops through (btn_1, btn_2, etc) and deletes the shapes using:
for i = 1 to (a certain number)
Set shp = f_overview.Shapes("btn_" & i)
shp.delete
next
Of course, it happens that the shape cannot be deleted because it simply does not exist. I have found that most of the time, the reccomended fix is to add (on error resume next) before setting the shape, as I get an error saying it does not exist. I have tried it inside the loop, before the loop, etc, like so:
for i = 1 to (a certain number)
On Error Resume Next
Set shp = f_overview.Shapes("btn_" & i)
shp.delete
next
As far as I understand it is supposed to loop right through if the shape doesn't exist, but I still get the same error whether or not I add the On error resume next! What am I doing wrong?
EDIT: There is no error when the shapes do exist.
I have found that most of the time, the reccomended fix is to add (on error resume next) before setting the shape, as I get an error saying it does not exist.
NO!
The recommended way to handle runtime errors is not to shove them under the carpet and continue execution as if nothing happened - which is exactly what On Error Resume Next does.
The simplest way to avoid runtime errors is to check for error conditions, and avoid executing code that results in 100% failure rate, like trying to run a method on an object reference that's Nothing:
For i = 1 To (a certain number)
Set shp = f_overview.Shapes("btn_" & i)
If Not shp Is Nothing Then shp.Delete
Next
In cases where you can't check for error conditions and must handle errors, the recommended way is to handle them:
Private Sub DoSomething()
On Error GoTo CleanFail
'...code...
CleanExit:
'cleanup code here
Exit Sub
CleanFail:
If Err.Number = 9 Then 'subscript out of range
Err.Clear
Resume Next
Else
MsgBox Err.Description
Resume CleanExit
End If
End Sub
There is nothing WRONG in using OERN (On Error Resume Next) provided you understand what you are doing and how it is going to affect your code.
In your case it is perfectly normal to use OERN
Dim shp As Shape
For i = 1 To (a certain number)
On Error Resume Next
Set shp = f_overview.Shapes("btn_" & i)
shp.Delete
On Error GoTo 0
Next
At the same time ensure that you don't do something like
On Error Resume Next
<Your Entire Procedure>
On Error GoTo 0
This will suppress ALL errors. Use proper error handling as shown by Matt
Edit:
Here is another beautiful example on how to use OERN This function checks if a particular worksheet exists or not.
Function DoesWSExist(wsName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets(wsName)
On Error GoTo 0
If Not ws Is Nothing Then DoesWSExist = True
End Function
If you wish you can also loop through all the sheets to check is the sheet exists or not!
Instead of trying to blindly delete shapes and skipping errors, why not run through the list of known shapes and delete them. Then you don't have to worry about an On Error Resume Next which often ends up being abused.
Sub Test(TheSheet As Worksheet)
Dim Shp as Shape
For Each Shp in TheSheet.Shapes
If left(Shp.Name, 4) = "btn_" Then
Shp.Delete
End if
Next
End Sub
If you want to delete all shapes, remove the If statement. If you want to delete a number of differently named shapes, modify the If statement appropriately.
It sounds like you have the wrong error trapping option set. Within the VBA Editor, Select Tools -> Options. In the window that opens, select the General tab, and pick the Break on Unhandled Errors radio button. This should allow Excel to properly process the On Error Resume Next command.
I suspect that you have Break on All Errors selected.
Try:
On Error Resume Next
for i = 1 to (a certain number)
Set shp = f_overview.Shapes("btn_" & i)
if err<>0 then err.clear else shp.delete
next
on Error Goto 0
so I have been searching through this forum for quite a while now, and also on other sites, but I just could not find a way to solve this problem.
So the small problem I got is, that I have a very long Excel Spreadsheet, with many different ID's, or numbers whatever you want to call them. From these ID's I create a custom link, which needs them to direct to a specific image, that is then pasted into a specific cell in this spreadsheet. Note that I really need this code, hence the spreadsheet is about 9300 lines/rows long. The problem now is that not every id has an image attached to it, which means that some links do not work (no image there, but also no text basically an empty page). Is there a way I can just let the code run through it, so that it ignores the error 1004 which is generated, which basically is always telling me he could not find something and will stop at that point.
I am a big noob at VBA, so please when answering do not use to complicated language. I will paste the code below, however the link is confidential, so I will replace the link with "link" or something like that. I tried several On Error methods, but either the error came up again, or Excel crashed, but here is the working code without any modifications to remove this error. Thanks in advance for all the help.
Sub Test()
I = 0
For I = 5 To 9373
If Tabelle2.Cells(I, 9) = "bekannt" Then
Call GetShapeFromWeb("Part 1 of the link" & Tabelle2.Cells(I, 10).Value & "Part 2 of the link", Tabelle2.Cells(I, 13))
End If
Next I
End Sub
Sub GetShapeFromWeb(strShpUrl As String, rngTarget As Range)
Dim shp As Shape
With rngTarget
With .Parent
.Pictures.Insert strShpUrl 'Error Occurs here
Set shp = .Shapes(.Shapes.count)
End With
shp.Left = .Left
shp.Top = .Top
End With
Set shp = Nothing
End Sub
One last thing to notice, some of the words are german, due to me being german and working with german variables, or links, or spreadsheets. And I am using excel 2007. The Error occurs in the following row ".Pictures.Insert strShpUrl" because it can not find a picture to insert.
Thansk a lot.
Kind Regards
Chris
//EDIT
One Idea I might have, which I dont know if it is possible, but the page it is directed to, when a picture is not there it displays the following "Unable to find /part/of/thelink/"
Could one maybe use a code to see if this message is displayed, and maybe check for that? If so how would that work? :) Maybe it could be added to the if statement at the top which tests already for this sub task.
//EDIT
Anyone got some idea? :S Maybe what I posted above in the edit could work? :S Is it possible to check if a msgbox displays something but the other way around so if the msgbox does not equal the following do this. If that could work it would be great! :S Or maybe instead of trying the on error commands trying it with an if statement within the GetShapeFromWeb sub? Any help is greatly appreciated.
This should work. However you wrote that you tried several On Error Methods unsuccessfully ... what does this one for you?
Sub GetShapeFromWeb(strShpUrl As String, rngTarget As Range)
Dim shp As Shape
Dim Er As Long: Er = 0
On Error GoTo gswError
With rngTarget
With .Parent
.Pictures.Insert strShpUrl
If Er <> 0 Then Exit Sub
Set shp = .Shapes(.Shapes.Count)
End With
shp.Left = .Left
shp.Top = .Top
End With
Set shp = Nothing
Exit Sub
gswError:
Er = Err
Resume Next
End Sub
have you tried on the GetShapeFromWeb sub, placing the On Error statement this way:
Sub GetShapeFromWeb(strShpUrl As String, rngTarget As Range)
Dim shp As Shape
On Error GoTo Err1 'inserting a picture from a blank link will cause an error... thus...
With rngTarget
With .Parent
.Pictures.Insert strShpUrl
Set shp = .Shapes(.Shapes.Count)
End With
shp.Left = .Left
shp.Top = .Top
End With
Err1: '...sidestep
Set shp = Nothing
End Sub
hey, first thanks to all for answering my other questions. I am extremely new to Excel VBA and some things I just get hung up on. I have a userform (not embedded in a worksheet) and I have a few fields that are for currency (amounts, etc) and if someone inputs a letter it errors after they hit the command button and they lose all info. I need error code to where I can tell them in a msgbox that they should not put characters in a currency field. I don't need it specific to those fields but I don't want them to lose there data when they hit the command button to dump the data into a spreadsheet.
How can I have them see the error msg, hit the ok button and have it take me right back to the screen without losing the data they have alread entered? Basically give them the opporunity to correct their error but not have to reinput 50 fields?
Thanks
Can't be specific without the actual code, but add error handlers to your code:
Sub SomeRoutine()
Dim stuff
On Error GoTo EH
' Code
Exit Sub
EH:
' Any errors with come here
If Err.Number = <specific errors to trap> Then
MsgBox "Oops..."
'As a debug tools, put a Resume here,
' but be sure to put a break on it,
' and don't leav it in the finished code
Resume
End If
End Sub
As I understand it you want the user to enter numeric numbers only into the text box - right? This is what I normally do.
In a global module add the following function:
Function IFF(c, t, f)
Dim v
If c Then v = t Else v = f
IFF = v
End Function
Then in your textbox_change event add the below:
Private Sub txtAmount_Change()
txtAmount.Text = IFF(IsNumeric(txtAmounto.Text), Val(txtAmount.Text), 0)
End Sub
This will basically put 0 in the box as soon as the user enters an invalid number.
Hope this helps
A slightly different take on error handlers than that given by chris neilsen
Sub SomeRoutine
On Error GoTo ErrHandler 'doesn't matter where you put it
'as long as it's before the code you want to protect
'Dim Stuff
'Do Stuff
ExitRoutine: 'Note the colon(:), which makes this a label
'Any cleanup that you _always_ want
Exit Sub
ErrHandler:
Select Case Err.Number
Case <some error you want to handle specially>
'special handling
Case Else
'default handling, which may include:
Resume ExitRoutine
End Select
Resume
End Sub
Note that that last Resume will never get hit in normal processing (if you've written your error-handling Cases correctly), but will let you set it as "Next Statement" when you're debugging in Break mode. This is an easy way to see exactly which statement threw the error.