Can you try this code below? I tested it with shapes that do not have a hyperlink address in addition to shapes that do have an address.
Sub Find_Image_URL()
'Application.ScreenUpdating = False
'Application.Calculation = xlCalculationManual
On Error Resume Next
For Each Shp In ActiveSheet.Shapes
If Not Application.Intersect(Range("E6:E60"), Shp.TopLeftCell) Is Nothing Then
Dim strURL As String
strURL = "" 'Set strURL to nothing
strURL = Shp.Hyperlink.Address 'If the hyperlink address is not valued then strURL will remain to be nothing
'If the hyperlink address is not valued, then error 1004 will be triggered
If Len(strURL) = 0 And Err.Number = 1004 Then
Range(Shp.TopLeftCell.Address) = False
End If
If InStr(strURL, "0") Then
Range(Shp.TopLeftCell.Address) = False
Else
Range(Shp.TopLeftCell.Address) = True
End If
End If
Err.Clear
Next Shp
End Sub
Tim
From: Louise Gariépy <garilou@cgocable.ca<mailto:garilou@cgocable.ca>>
Reply-To: "ExcelVBA@yahoogroups.com<mailto:ExcelVBA@yahoogroups.com>" <ExcelVBA@yahoogroups.com<mailto:ExcelVBA@yahoogroups.com>>
Date: Wednesday, 23 April 2014 2:12 pm
To: "ExcelVBA@yahoogroups.com<mailto:ExcelVBA@yahoogroups.com>" <ExcelVBA@yahoogroups.com<mailto:ExcelVBA@yahoogroups.com>>
Subject: Re: [ExcelVBA] Find if image has hyperlink
Sorry Paul,
But before I wrote this message, I had already tried the on error Resume Next.
It does not work.
I know pretty well the error handling codes.
Louise
Le --23042014 à 02:08, Paul Vermeulen <paul.vermeulen@vulcantech.com.au<mailto:paul.vermeulen@vulcantech.com.au>> a écrit :
My apologies, Louise, GoTo should be Resume. On Error Resume Next. ;)
You should also read Chip Pearson's advice on http://www.cpearson.com/excel/errorhandling.htm.
Paul
From: ExcelVBA@yahoogroups.com<mailto:ExcelVBA@yahoogroups.com> [mailto:ExcelVBA@yahoogroups.com] On Behalf Of Louise Gariépy
Sent: Wednesday, 23 April 2014 2:03 PM
To: ExcelVBA@yahoogroups.com<mailto:ExcelVBA@yahoogroups.com>
Subject: Re: [ExcelVBA] Find if image has hyperlink
Thank you Paul for this prompt reply.
1. Could you write the exact code that you think of, because I am used to
On Error GoTo errTrap
and at the end:
errTrap:
code ...
If I write at the beginning:
On Error goto next, or GoTo Next
I get an script error,
and if I write it in the errTrap:
GoTo Next
I also get a script error.
2. It would not solve the problem that in the case of an error for that particular cell (there is an image but no hyperlink), I would need to write FALSE in the cell.
Louise
Le --23042014 à 01:30, Paul Vermeulen <paul.vermeulen@vulcantech.com.au<mailto:paul.vermeulen@vulcantech.com.au>> a écrit :
Hi Louise
Just use an error-catch to say On Error goto next. Place it above you For statement and on an error it will just go to the next picture.
Regards
Paul
From: ExcelVBA@yahoogroups.com<mailto:ExcelVBA@yahoogroups.com> [mailto:ExcelVBA@yahoogroups.com] On Behalf Of Louise Gariépy
Sent: Wednesday, 23 April 2014 1:26 PM
To: excelvba@yahoogroups.com<mailto:excelvba@yahoogroups.com>
Subject: [ExcelVBA] Find if image has hyperlink
Hi Group!
First I want to apologize if I have double posted.
I first sent this to the wrong group, (ms_excel), but I do not see it appear.
I have a worksheet where I copy paste HTML code for a group of symbols.
In column E, I do not receive text, but images (some rows have no image at all and it means something else)
The hyperlinks on the images carry the information that I need.
Until recently, some images had as hyperlink content: "0", the other ones had text.
For me, it was enough to detect if there was text: then the cell content was set to TRUE.
For the images where the hyperlink content was "0", then the cell content was set to FALSE.
My code was:
--------------------------------
Sub Find_Image_URL()
'Application.ScreenUpdating = False
'Application.Calculation = xlCalculationManual
For Each Shp In ActiveSheet.Shapes
If Not Application.Intersect(Range("E6:E60"), Shp.TopLeftCell) Is Nothing Then
strUrl = Shp.Hyperlink.Address
If InStr(strUrl, "0") Then
Range(Shp.TopLeftCell.Address) = False
Else
Range(Shp.TopLeftCell.Address) = True
End If
end if
Next Shp
End Sub
-------------------------------------
Now the web site has changed.
The hyperlink that used to be 0 on the web site are now "NO PATTERN", but this is NOT copied when pasted on the sheet.
So the code blocks on
strUrl = Shp.Hyperlink.Address
because there is no hyperlink
I can't find a way to write something like
If "there is no hyperlink" then
Range(Shp.TopLeftCell.Address) = False
Thanks for your always great help,
Louise G.
| Reply via web post | Reply to sender | Reply to group | Start a New Topic | Messages in this topic (7) |
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.
----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA
----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com
----------------------------------
Tidak ada komentar:
Posting Komentar