Link data with imageClosed

Question

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



Configuration: Windows 7 / Internet Explorer 9.0

rizvisa1 · Answer

see this 
https://ccm.net/forum/affich-269046-adding-a-loop-to-macro-to-insert-pictures

Pooja V · Answer

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

Link data with image

2 replies

Subscribe To Our Newsletter!