Add a Pictures File Name and Path to a cell ?

[Corey]

The folowing code places a Picture into a cell, but i need to add the pictures name and file path to
a cell (Offset(0,8) from where it is placed.
How can i code this? See below CAPITAL TEXT to see where i need it ?

Application.ScreenUpdating = False
Sheets("JSA Procedure").Select
If ActiveCell.Height <> 220.5 Then
MsgBox "Please Select the Large Photo Cell where you require the Photo FIRST.", vbExclamation
Exit Sub
Else
Dim ans As String
ans = InputBox("What is the Photo of, " & vbCrLf & vbCrLf & vbTab & "This or That ?", "....")
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim myPic As Picture
Dim res As Variant
'Const sAddress As String = ActiveCell
Set WB = ActiveWorkbook
res = Application.GetOpenFilename _
("Image Files (*.jpg), *.jpg")
If res = False Then Exit Sub
Set SH = ActiveSheet
Set rng = ActiveCell
Set myPic = SH.Pictures.Insert(res)
With myPic
.Top = rng.Top
.Left = rng.Left
myPic.ShapeRange.LockAspectRatio = msoTrue
' myPic.ShapeRange.Height = 220#
myPic.ShapeRange.Width = 278
myPic.ShapeRange.Rotation = 0#
ActiveCell.Offset(2, 0).Value = ans
ActiveCell.Offset(, 8).Value = WANT PICTURES FILEPATH AND NAME HERE
End With
End If
Application.ScreenUpdating = True


Regards

ctm

 

[Muhammed Rafeek M]

use: ActiveCell.Offset(, 8).Value = res

pls do rate

 

[JE McGimpsey]

One way:

Const csTOOSMALL As String = _
"Please Select the Large Photo Cell where" & _
" you require the Photo FIRST."
Const csPROMPT As String = _
"What is the Photo of, " & vbCrLf & vbCrLf & _
vbTab & "This or That ?"
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
Dim picMyPic As Picture
Dim vRes As Variant
Dim sAns As String

Application.ScreenUpdating = False
Set wb = ActiveWorkbook
Set ws = wb.Sheets("JSA Procedure")
ws.Select
If ActiveCell.Height <> 220.5 Then
MsgBox csTOOSMALL, vbExclamation
Exit Sub
Else
sAns = InputBox(csPROMPT, "....")
vRes = Application.GetOpenFilename _
("Image Files (*.jpg), *.jpg")
If vRes = False Then Exit Sub
Set rng = ActiveCell
Set picMyPic = ws.Pictures.Insert(vRes)
With picMyPic
.Top = rng.Top
.Left = rng.Left
.ShapeRange.LockAspectRatio = msoTrue
.ShapeRange.Width = 278
.ShapeRange.Rotation = 0#
End With
rng.Offset(2, 0).Value = sAns
rng.Offset(0, 8).Value = vRes
End If
Application.ScreenUpdating = True

 

[Corey]

Simple as thet hey ?

Thank you.
For some reason the (res) would NOt appear in Cell (offset(,8) but would in Cell.Offset(4,0) ??

Shall do the trick though, thanks Muhammed....

use: ActiveCell.Offset(, 8).Value = res

pls do rate