Snasui Excel Forum

Code: Select all

Sub ShowPicture()
    Dim r As Range, ra As Range
    Dim imgIcon As Object
    Dim obj As Object
    On Error Resume Next
    With Worksheets("Sheet4")
        Set ra = .Range("G4", .Range("F65536").End(xlUp).Offset(0, 1))
    End With
    For Each obj In ActiveSheet.Shapes
        If Left(obj.Name, 4) = "Pict" Then
            obj.Delete
        End If
    Next obj
    For Each r In ra
        r.ClearContents
        Set imgIcon = ActiveSheet.Shapes.AddPicture( _
        Filename:="D:\piccar\" & r.Offset(0, -1).Value & ".jpg", LinkToFile:=False, _
        SaveWithDocument:=True, Left:=r.Left, Top:=r.Top, _
        Width:=r.Width, Height:=r.Height)
        If Err <> 0 Then
            r = "ระบุรหัสไม่ถูกต้อง"
            On Error GoTo 0
        End If
    Next r
End Sub