Snasui Excel Forum

Code: Select all

With Cells(Target.Row, "B")
Set myPict = Cells(Target.Row, "B").Parent.Pictures.insert("D:\imagee\" & Target.Value & ".jpg")
    myPict.Top = .Top
    myPict.Width = .Width
    myPict.Height = .Height
    myPict.Left = .Left
    myPict.Placement = xlMoveAndSize
End With

Code: Select all

Sub STAMP_P4()
   Dim sFile As Variant, r As Range
    Dim imgIcon As Object
    Set r = Range("P4").MergeArea
    sFile = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", _
        Title:="Browse to select a picture")
    If sFile = False Then Exit Sub
    
    Set imgIcon = ActiveSheet.Shapes.AddPicture( _
        Filename:=sFile, _
        LinkToFile:=False, _
        SaveWithDocument:=msoCTrue, _
        Left:=r.Left, _
        Top:=r.Top)

End Sub

Code: Select all

 For Each r In ra
        Set imgIcon = ActiveSheet.Shapes.AddPicture( _
        Filename:="D:\imagee\" & r.Offset(0, -1).Value & ".jpg", LinkToFile:=False, _
        SaveWithDocument:=True, Left:=r.Left, Top:=r.Top, _
        Width:=r.Width, Height:=r.Height)
        
    Next r

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Columns("P")) Is Nothing Then Exit Sub
Dim myPict As Picture

With Cells(Target.Row, "O")
Set myPict = Cells(Target.Row, "O").Parent.Pictures.insert("D:\imagee\" & Target.Value & ".jpg")
    myPict.Top = .Top
    myPict.Width = .Width
    myPict.Height = .Height
    myPict.Left = .Left
    myPict.Placement = xlMoveAndSize
End With

End Sub

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Columns("I")) Is Nothing Then Exit Sub
Dim myPict As Picture

With Cells(Target.Row, "B")
Set myPict = Cells(Target.Row, "B").Parent.Pictures.insert("D:\imagee\" & Target.Value & ".jpg")
    myPict.Top = .Top
    myPict.Width = .Width
    myPict.Height = .Height
    myPict.Left = .Left
    myPict.Placement = xlMoveAndSize
End With

End Sub