View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.misc
Ron Coderre Ron Coderre is offline
external usenet poster
 
Posts: 2,118
Default Help with importing pictures from hyperlinks

If you'd consider putting the hyperlinked pictures in the cells' comments,
then putting the mouse pointer over the cell would display the associated
picture.

Here's how:

First, add the below procedures to a General Module
(Watch out for text wrap issues)

To run the macros....
1) Select the range of hyperlink cells that reference pictures
2) Run the "ConvertLinksToCommentPics" macro
<tools<macro<macros.....Select: ConvertLinksToCommentPics...Click: Run

The hyperlinks will be removed and the linked pictures will be inserted into
the cells comments.


Sub ConvertLinksToCommentPics()
Dim cCell As Range
Dim rngSelection As Range
Dim strHLink As String
Dim cComment As Comment

Dim iNewHgt As Integer
Dim iNewWidth As Integer

For Each cCell In Selection
If cCell.Hyperlinks.Count 0 Then
'The cell contains a hyperlink
With cCell
'Store the hyperlink target
strHLink = .Hyperlinks(1).Address

If strHLink < "" Then
.Hyperlinks(1).Delete

'If the cell doesn not contain a comment create one
Set cComment = .Comment
If cComment Is Nothing Then
Set cComment = .AddComment(Text:="")
End If

'Build a temporary picture shape to read dimensions from
'then delete the shape containing the picture
InsertPicFromFile _
strFileLoc:=strHLink, _
rDestCells:=[A1], _
blnFitInDestHeight:=False, _
strPicName:="TempPic"

With ActiveSheet.Shapes("TempPic")
iNewHgt = .Height
iNewWidth = .Width
End With

ActiveSheet.Shapes("TempPic").Delete

'Alter the comment to use the picture as the Fill
'and size the shape to the original picture size
With cComment.Shape
.Fill.UserPicture PictureFile:=strHLink
.LockAspectRatio = msoFalse
.Height = iNewHgt
.Width = iNewWidth
End With
End If
End With
End If
Next cCell
End Sub

'******************************
'* InserPicFromFile *
'* Programmer: Ron Coderre *
'* Last Update: 20-SEP-2007 *
'******************************
Sub InsertPicFromFile( _
strFileLoc As String, _
rDestCells As Range, _
blnFitInDestHeight As Boolean, _
strPicName As String)

Dim oNewPic As Shape
Dim shtWS As Worksheet

Set shtWS = rDestCells.Parent

On Error Resume Next
'Delete the named picture (if it already exists)
shtWS.Shapes(strPicName).Delete

On Error Resume Next
With rDestCells
'Create the new picture
'(arbitrarily sized as a square that is the height of the rDestCells)
Set oNewPic = shtWS.Shapes.AddPicture( _
Filename:=strFileLoc, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=.Left + 1, Top:=.Top + 1, _
Width:=.Height - 1, Height:=.Height - 1)

'Maintain original aspect ratio and set to full size
oNewPic.LockAspectRatio = msoTrue
oNewPic.ScaleHeight Factor:=1, RelativeToOriginalSize:=msoTrue
oNewPic.ScaleWidth Factor:=1, RelativeToOriginalSize:=msoTrue

If blnFitInDestHeight = True Then
'Resize the picture to fit in the destination cells
oNewPic.Height = .Height - 1
End If

'Assign the desired name to the picture
oNewPic.Name = strPicName
End With 'rCellDest
End Sub


Is that something you can work with?
Post back if you have more questions.
--------------------------

Regards,

Ron
Microsoft MVP (Excel)
(XL2003, Win XP)

"forxigan" wrote in message
...
I have an excel table which contains a list of products.
One of the columns contains a list of hyperlinks to each product's
picture,
on a certain website.
I need a solution to get/import the actual pictures from the website to my
table, according to each product's hyperlink(i can translate each
hyperlink
into a cell with the web adress of the picture, if it helps).

Thanks in advance.