Link data with image

[Closed]
Report
Posts
4
Registration date
Wednesday October 30, 2013
Status
Member
Last seen
November 11, 2013
-
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
-
Hello,

I have C:\Photo folder with all jpeg images.
All the names are unique and exactly matches with my
product code number.

In excel 2007 I want to match my code number with the
image name and display the image.

My range for giving the code number (without .jpeg extension) C8:C28. Anywhere
from C8 to C28 I will mention from 1 to max 10 code
numbers. The first five image (as per code number sequence )
will display from D4 to H4 ( 0.75 x 0.75 inch )
and second five from D6 to H6 ( 0.75 x 0.75 inch ).

IMPORTANT: In case the code number doesnot have the matching
image then the image box should be blank.

thanks
Pooja V



2 replies

Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
Posts
4
Registration date
Wednesday October 30, 2013
Status
Member
Last seen
November 11, 2013

hello rizvisa1

This was the changes I had done in you code
I had right clicked on sheet1 - View Code and pasted the code.

Sub Picture()
Dim picname As String

Dim pasteAt As Integer
Dim lThisRow As Long

lThisRow = 2

Do While (Cells(lThisRow, 2) <> "")

'Range("A6").Select 'This is where picture will be inserted
pasteAt = lThisRow
Cells(pasteAt, 1).Select 'This is where picture will be inserted

'Dim picname As String
'picname = Range("B6") 'This is the picture name
picname = Cells(lThisRow, 2) 'This is the picture name

ActiveSheet.Pictures.Insert("C:\Photo\" & picname & ".jpg").Select 'Path to where pictures are stored
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This resizes the picture
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Selection
'.Left = Range("A6").Left
'.Top = Range("A6").Top
.Left = Cells(pasteAt, 1).Left
.Top = Cells(pasteAt, 1).Top

.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 100#
.ShapeRange.Width = 80#
.ShapeRange.Rotation = 0#
End With

lThisRow = lThisRow + 1

Loop

Range("A10").Select
Application.ScreenUpdating = True

Exit Sub

ErrNoPhoto:
MsgBox "Unable to Find Photo" 'Shows message box if picture not found
Exit Sub
Range("B20").Select

End Sub

I changed the path . But when I enter any name in B column , I am not
getting any pic.. Is there any mistake I have done in the path.

Also can the code be changed as per my requirement, because in my case
there will be blanks at some place in the range and the are where I want the
pics is also different.

Thanks
Pooja
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
current macro is "on demand" run. If you want to do it on entry, a little tweak is needed. Also you would need to leverage the events to do that