Excel Forum

Code: Select all

Sub ShowPicture()
Dim r As Range
Dim obj As Object
Dim imgIcon As Object
Dim s As Shape
On Error Resume Next
With Worksheets("สารบัญ")
    Set r = .Range("y1")
 End With
    For Each s In ActiveSheet.Shapes
        If Intersect(r, s.TopLeftCell) Is Nothing Then
        Else
            s.Delete
        End If
    Next s
    Set imgIcon = ActiveSheet.Shapes.AddPicture( _
    Filename:="D:\2020\" & r.Offset(0, -1).Value & ".jpg", LinkToFile:=False, _
    SaveWithDocument:=True, Left:=r.Left + 1.5, Top:=r.Top + 1.5, _
    Width:=r.Width + 61, Height:=r.Height + 82)
End Sub