path string in cell

[shah1419]

i have folder which contain the "jpg" images. i have table wiuth three fields.

ID Autonumber
Pictname text ---255
Picpath Text--255

Recrods /Data in table
ID = 1
Picname Red
PicPath 'f:\cards\desktop\red.jpg'
ID = 2
Picname blue
PicPath 'f:\cards\desktop\blue.jpg' or "f:\cards\desktop\blue.jpg"

but when i call/retrive this picure in image box it is showing f:\cards\desktop\blue.jpg not the picture. wether i have tried to store this path in this format also. but not succesed. "
please advised.

[mancubus]

post your workbook as explained in my signature.

[shah1419]

please view the attached file

[Kenneth Hobs]

How are you calling or retrieving pictures? If by code, please click the # icon and paste between codes.

If done manually, I suspect that blue.jpg is not an actual jpg file.

[shah1419]

Dim picname As String
 
Range("B1").Select  'This is where picture will be inserted 
 
picname = Range("A1")  'This is the picture name 
 
On Error Resume Next
  'delete previous pic 
ActiveSheet.Pictures("ProfilePicture").Delete
Err.Clear
Err.Number = 0
On Error GoTo 0
 
If (Dir("C:\Users\JINOOB\Desktop\I A\" & picname & ".jpg") = vbNullString) Then Exit Sub
 
ActiveSheet.Pictures.Insert("C:\Users\JINOOB\Desktop\I A\" & picname & ".jpg").Select  'Path to where pictures are stored 
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
  ' This resizes the picture 
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
With Selection
    .Name = "ProfilePicture"
    .Left = Range("B1").Left
    .Top = Range("B1").Top
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.Height = 95#
    .ShapeRange.Width = 80#
    .ShapeRange.Rotation = 0#
End With
End Sub

[Kenneth Hobs]

Your code only deals with one pic. Pictures.Insert() insert links to pics.

I used Shapes.AddPicture() to embed the pics though it can link pics too. Put this in a Module and call as you like. Use whichever Set s that you like best.

Sub Main()    
  Dim c As Range, r As Range, p As Range
  Dim s As Shape, fn$
  
  On Error Resume Next
  Set r = Range("B2", Cells(Rows.Count, "B").End(xlUp))
  For Each c In r
    Set p = c.Offset(, 2) 'Column D
    fn = c.Offset(, 1)  'Column C value
    Set s = ActiveSheet.Shapes.AddPicture _
      (fn, msoFalse, msoTrue, _
        p.Left, p.Top, 80, 95) 'embed files
    'Set s = ActiveSheet.Shapes.AddPicture _
      (fn, msoFalse, msoTrue, _
        p.Left, p.Top, p.Width, p.RowHeight) 'embed files
    s.LockAspectRatio = False
    s.Name = c
  Next c
End Sub