Pulling a Thumbnail from a link

[anoop0085]

Dear guys ;

I would like to display a thumbnail from a url based on item code by clicking a button (vba) , take a note that i am using 2016 excel

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	Item code	url link
2	MCL-FLR-558	https://www.example.com/image1.jpg
3	MCL-FLR-559	https://www.example.com/image2.jpg									??? need to display thumb nail image here from url given
4	MCL-SRW-200	https://www.example.com/image3.jpg
5	MCL-TBE-074	https://www.example.com/image1.jpg						itemcode:	MCL-SRW-200
6	MCL-SRW-195	https://www.example.com/image2.jpg
7	MCL-VLV-1226	https://www.example.com/image3.jpg
8	MCL-TBE-071	https://www.example.com/image1.jpg
9	MCL-TBE-072	https://www.example.com/image2.jpg
10	ELS-GSP-464	https://www.example.com/image3.jpg
11	ELS-SNR-246	https://www.example.com/image1.jpg
12	MCL-SRW-196	https://www.example.com/image2.jpg
13	MCL-SRW-197	https://www.example.com/image3.jpg
14	MCL-SRW-198	https://www.example.com/image1.jpg
15	MCL-SRW-199	https://www.example.com/image2.jpg
16
17
18
Sheet1

 

[Anthony47]

In case the problem is still open, try this macro:

Private Sub Worksheet_Change(ByVal Target As Range)
'https://www.mrexcel.com/board/threads/pulling-a-thumbnail-from-a-link.1214203/
Dim PictName
Dim cPic As Shape, pLeft As Single, pTop As Single
'
If Target.Address = "$I$5" Then
    PictName = Application.VLookup(Range("I5").Value, Range("A1:B10000"), 2, False)
    If IsError(PictName) Then
        PictName = "D:\DImmagini\Moon_shot.jpg"                 '<<< A Default Image
    End If
    On Error Resume Next
        ActiveSheet.Shapes("Zczc_CPict").Delete
    On Error GoTo 0
    'Insert Picture:
        pLeft = Range("K3").Left
        pTop = Range("K3").Top
        Set cPic = ActiveSheet.Shapes.AddPicture(PictName, False, True, pLeft, pTop, True, True)
        With cPic
            .LockAspectRatio = msoFalse
            .Height = Range("K3").MergeArea.Height
            .Width = Range("K3").MergeArea.Width
    '        .Left = pLeft                                      'See message
    '        .Top = pTop
            .Name = "Zczc_CPict"
        End With
End If
End Sub

It has to be inserted into the vba class module of the worksheet:
-rightclick on the tab with the name of the sheet, select Display code; this will open the vba editor at the right position
-copy the code and paste it into the right "empty" frame of the vba editor; if that page already contains some code then publish it to check for possible compatibility problems.

The macro will excecute whenever cell I5 get changed
In case vlookupping I5 in the table A:B doesn't return any value then the macro will insert a default image; you have to insert the path and name of this default image, in the line marked <<< in the code above
Note that the inserted image will loose its H/W ratio, so it may appear distorted. If this is a problem then we need to set .LockAspectRatio = msoTrue but then you need to clarify wich size (Height or Width of the destination area) has to be set and thus we need to modify the instructions between the With /End With lines
Also, it could happens that the image does not center into the destination area after the resizing; if this happens then uncomment (ie remove the leading "apostrophe") on the two lines .Left= and .Top=

Try...

 

[anoop0085]

thanks for reply , it works

 

[Anthony47]

Thank you for the feedback