Replace text in cell with picture (or insert picture into same cell)

[mdmackillop]

Much easier if you put the pictures on a hidden sheet in the workbook.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Select Case LCase(Target.Formula)
    Case "z.1"
    Sheets("Sheet2").Shapes("Picture 1").Copy
    Case "z.2"
    Sheets("Sheet2").Shapes("Picture 2").Copy
    'etc.
End Select
ActiveSheet.Paste
Selection.Top = Target.Top
Target.Select
End Sub

Alternative for subfolder

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Call Test2(Target)
End Sub


Sub Test2(Target)
Dim Pth As String
Dim Pic As Object
    Pth = ActiveWorkbook.Path & "\Pics\"
    Select Case LCase(Target.Formula)
        Case "z.1"
            Set Pic = ActiveSheet.Pictures.Insert(Pth & "Pic1.jpg")
        Case "z.2"
            Set Pic = ActiveSheet.Pictures.Insert(Pth & "Pic2.jpg")
        'etc.
    End Select
    Pic.Top = Target.Top
End Sub