Changing picture based on cell value

Yuvi0007 · Feb 11th 2020

By changing text in cell the image has to paste from file.I used below Code it's working fine But once you delete the images from file then the image from excel disappears and showing error. Is it any option instead of Insert can we auto paste in excel.

Code

Private Sub Worksheet_change(ByVal Target as Range)
Dim shp As Shape
If Intersect (Target,[A:A]) Is Nothing Then Exit Sub
If Target.Row Mode 20=0 Then Exit Sub
On Error Go to son
For Each shp In ActiveSheet.Shapes
If shp.Type =msoPicture And shp.TopLeftCell.Address= Target.Offset(0,1).Address Then shp.Delete
Next
ActiveSheet.Pictures.Insert (Thisworkbook.Path &"\"& Target.Value &".JPG").Select
Selection.Top=Target.Offset(0,1).Top
Selection.Left = Target.Offset(0,1).left
With Selection.ShapRange
.LockAspectRatio = msoFalse
.Height = Target.Offset (0,1).Height
.Width = Target.Offset(0,1).Width
End With
Target.offset(1,0).Select
son:
End Sub

Display More

**royUK** · Feb 11th 2020

Please read the Forum Rules and in future use Code Tags when posting code on the Forum

**royUK** · Feb 11th 2020

Try this code, it uses a fixed range but it would be easy to amend the code to allow the user to select a range

Code

Option Explicit

''///With the macro below you can insert pictures and fit them to any range in a worksheet.

Sub TestInsertPictureInRange()
Dim picToOpen As String
picToOpen = Application _
.GetOpenFilename("Pics (*.jpg), *.jpg")

If picToOpen <> "" Then InsertPictureInRange picToOpen, _
Range("B5:D10")
End Sub

Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
''/// inserts a picture and resizes it to fit the TargetCells range
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
''/// import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
''/// determine positions
With TargetCells
t = .Top
l = .Left
w = .Offset(0, .Columns.Count).Left - .Left
h = .Offset(.Rows.Count, 0).Top - .Top
End With
''/// position picture
With p
.Top = t
.Left = l
.Width = w
.Height = h
End With
Set p = Nothing
End Sub

Display More

Yuvi0007 · Feb 11th 2020

Hi...Thank for Code.

I used above code but its help to only copy paste.

Actually Buy using below code based on cell [A:A] value i can able to auto call image from file and inserting in next cell in excel.

ex: If I Type 0007 in cell A1 then micro check for image in file, name 0007.JPG and it Inserts it in Cell B1.

But Problem is, it's Dynamic image , Once i delete photo from file/Folder or if i move a Excel in another location the Cell B1 image will Disapperse with box in Cell B1 as "picture cannot be displayed unlinked or deleted "

Any solution Instead of insert can we insert as copy , Paste as static image in excel , so i can move the excel any folder or location.

Code

Private Sub Worksheet_change(ByVal Target as Range)

Dim shp As Shape

If Intersect (Target,[A:A]) Is Nothing Then Exit Sub

If Target.Row Mode 20=0 Then Exit Sub

On Error Go to son

For Each shp In ActiveSheet.Shapes

If shp.Type =msoPicture And shp.TopLeftCell.Address= Target.Offset(0,1).Address Then shp.Delete

Next

ActiveSheet.Pictures.Insert (Thisworkbook.Path &"\"& Target.Value &".JPG").Select

Selection.Top=Target.Offset(0,1).Top

Selection.Left = Target.Offset(0,1).left

With Selection.ShapRange

.LockAspectRatio = msoFalse

.Height = Target.Offset (0,1).Height

.Width = Target.Offset(0,1).Width

End With

Target.offset(1,0).Select

son:

End Sub

Display More

**royUK** · Feb 12th 2020

I tested my code and the image remained after I moved it from it's original folder.

Yuvi0007 · Feb 12th 2020

Yes your code works fine. but i wanted to add image based on cell A "text" = image "name" in folder.

any solution?

Yuvi0007 · Feb 17th 2020

Hi.

need solution on below code .

ex: If i type xyz in cell "A" the code has to call xyz image from folder and paste in cell "B"

I am using below code but once I move excel or delete photos form folder showing error.The linked image cannot be displayed. the file may have been moved, renamed, or deleted verify that the link points the correct file and location"

Can we modify below code by Shapes.AddPicture Or any other static image code ?

Code

Private Sub Worksheet_change(ByVal Target as Range)

Dim shp As Shape

If Intersect (Target,[A:A]) Is Nothing Then Exit Sub

If Target.Row Mode 20=0 Then Exit Sub

On Error Go to son

For Each shp In ActiveSheet.Shapes

If shp.Type =msoPicture And shp.TopLeftCell.Address= Target.Offset(0,1).Address Then shp.Delete

Next

ActiveSheet.Pictures.Insert (Thisworkbook.Path &"\"& Target.Value &".JPG").Select

Selection.Top=Target.Offset(0,1).Top

Selection.Left = Target.Offset(0,1).left

With Selection.ShapRange

.LockAspectRatio = msoFalse

.Height = Target.Offset (0,1).Height

.Width = Target.Offset(0,1).Width

End With

Target.offset(1,0).Select

son:

End Sub

Display More

**royUK** · Feb 17th 2020

Are you planning to use the worksheet change event?

Yuvi0007 · Feb 17th 2020

I have few photos with Names and saved in one folder. also i have excel where Photos Names are in Cell"A" and i want to map these photos in Cell "B" (copy paste). i can able to do it by above code but once i move excel or photos it giving error "The linked image cannot be displayed. the file may have been moved, renamed, or deleted verify that the link points the correct file and location"

so if there is any other code to paste photos in cell"B" based on Cell "A" Values ?

**royUK** · Feb 17th 2020

Haven't I provided code for you in a different post? Also, please answer my question.

Yuvi0007 · Feb 17th 2020

yes.....you provided code.

but that is different. Where I am adding photos from user form to excel.

But this thread is different..in this, I am calling images from folder to excel based on cell "A" value..my code is working but I am not able to add a static image/shapes.addpicture.

**royUK** · Feb 18th 2020

You just need to use the same code.

**royUK** · Feb 18th 2020

Try this

Code

Private Sub Worksheet_change(ByVal Target As Range)
Dim rCl As Range
Dim shp As Shape
Dim fPath As String
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
If Target.Row Mod 20 = 0 Then Exit Sub
On Error GoTo son
For Each shp In ActiveSheet.Shapes
If shp.Type = msoPicture And shp.TopLeftCell.Address = Target.Offset(0, 1).Address Then shp.Delete
Next

ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Target.Value & ".JPG").Select
Set rCl = Target
fPath = ThisWorkbook.Path & "\" & Target.Value & ".JPG"
ActiveCell.Shapes.AddPicture fPath, LinkToFile:=msoFalse, savewithdocument:=msoCTrue, Left:=rCl.Left, Top:=rCl.Top, Width:=rCl.Width, Height:=rCl.Height

'    With Selection.ShapRange
'        .LockAspectRatio = msoFalse
'        .Height = Target.Offset(0, 1).Height
'        .Width = Target.Offset(0, 1).Width
'    End With
Target.Offset(1, 0).Select
son:
End Sub

Display More

Yuvi0007 · Apr 6th 2020

Same error is shown once i delete image from folder "The linked image cannot be displayed. the file may have been moved, renamed, or deleted verify that the link points the correct file and location" and also it is not adjusting with Cell Size. I am attaching Excel file provide code.

Thank you.

**royUK** · Apr 6th 2020

You don't expect an error if you delete the file?

Yuvi0007 · Apr 6th 2020

Yes if i delete a photo from folder image has to be in Excel ....but now its giving error. photos need to add as like copy paste nots link.

Yuvi0007 · Apr 8th 2020

Otherwise any code to break a link of linked image in excel. (getting error if i move/copy excel from one folder to another and when i delete photos from folder, image place it is showing above error ) ?

Changing picture based on cell value

Participate now!

Share

Tags