Extracting links from images

  • Thread starter Thread starter Fred Taylor
  • Start date Start date
F

Fred Taylor

Heloo All,

I have a page formatted this way:

Column A Column B Column C
Company Phone Web Site


The column C has icons with links to the web sites address.

How can I convert these links to text (such as www.example.com) instead of
having the links attached to the icons?

thanks in advance
 
Hi Fred,

You can extract the hyperlink like this:

Sheets("Sheet1").Shapes(1).Hyperlink.Address

If you want to delete the Shapes and replace them with text URLs, you could
do something like this:

Sub RemoveImagesWithHyperlinks()
Dim shp As Shape
Dim bHasLink As Boolean

For Each shp In Sheets("Sheet1").Shapes
On Error Resume Next
bHasLink = Len(shp.Hyperlink.Address)
On Error GoTo 0
If bHasLink Then
shp.TopLeftCell.Value = "'" & shp.Hyperlink.Address
shp.Delete
End If
bHasLink = False
Next shp
End Sub
 
Sub Tester1()
Dim hLink As Hyperlink
Dim rng As Range
For Each hLink In ActiveSheet.Hyperlinks
If TypeName(hLink.Parent) = "Shape" Then
Set rng = hLink.Parent.TopLeftCell.Offset(0, 2)
rng.Value = hLink.Address
End If
Next
End Sub

You could also delete the hyperlink in the loop as well (an the shape as
well I assume)

Sub Tester1()
Dim hLink As Hyperlink
Dim rng As Range
For Each hLink In ActiveSheet.Hyperlinks
If TypeName(hLink.Parent) = "Shape" Then
Set rng = hLink.Parent.TopLeftCell.Offset(0, 2)
rng.Value = hLink.Address
hLink.Delete
End If
Next
End Sub
 
tx Tom. you're good.


Tom Ogilvy said:
Sub Tester1()
Dim hLink As Hyperlink
Dim rng As Range
For Each hLink In ActiveSheet.Hyperlinks
If TypeName(hLink.Parent) = "Shape" Then
Set rng = hLink.Parent.TopLeftCell.Offset(0, 2)
rng.Value = hLink.Address
End If
Next
End Sub

You could also delete the hyperlink in the loop as well (an the shape as
well I assume)

Sub Tester1()
Dim hLink As Hyperlink
Dim rng As Range
For Each hLink In ActiveSheet.Hyperlinks
If TypeName(hLink.Parent) = "Shape" Then
Set rng = hLink.Parent.TopLeftCell.Offset(0, 2)
rng.Value = hLink.Address
hLink.Delete
End If
Next
End Sub
Click to expand...
 
Back
Top