Insert image from Cell value



The below code inserts an image into the activecell and sizes it to suit.
It also places an explaination into the cell 2 rows down from the image.

Then it places the image address eg. (\\Stserver\st server\My Pictures\BlueScope Steel\F58\F58
(7).jpg) in the cell a further 2 rows down.

What i want to be able to do, IF POSSIBLE, is to using that address place the image back in the cell
if required again.

Once this sheet is completed, i use a macro to store the data(minus the pictures) in another sheet.

But if the user wants to view an existing report, they run a macro which brings the stored data back
into this sheet. (THIS IS LAREDAY DONE)
But as the pictures are NOT stored, but are deleted fromt he sheet before storing the rest of the
data, i want to know IF it is POSSIBLE to bring the pictures back into the original cell IF the user
wants to view a previous report.
I store the cell data that contains the picture and want to know if a macro WILL/CAN use this to
place the corrcet image back int he report for viewing. (Assuming the image has not been moved from
its original folder/drive)

Sub Button9_Click()
Application.ScreenUpdating = False
Sheets("JSA Procedure").Select
Sheets("JSA Procedure").Unprotect
If ActiveCell.Height <> 220.5 Then
MsgBox "Please Select the Large Photo Cell where you require the Photo FIRST.", vbExclamation
Exit Sub
Dim ans As String
ans = InputBox("What is the Photo of, " & vbCrLf & vbCrLf & vbTab & "Take Up or Splicing Station ?",
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(4, 0).Value = res ' <==== HERE
End With
End If
Sheets("JSA Procedure").Protect
Application.ScreenUpdating = True
End Sub

Can anyone advise if this is possible and if so how?

NB: Noticed the Backslashes in the image address are actually stored as a Y type character???
But when copied are pasted as a backslash???



Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question