You must use Shapes.AddPicture rather than Pictures.Insert:
Sub InsertPictures()
Dim strPath As String
Dim strFile As String
Dim objPic As Shape
Dim LastRow As Long
Dim i As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
If LastRow = 1 Then
MsgBox "No data is available...", vbInformation
Exit Sub
End If
Application.ScreenUpdating = False
strPath = "C:\Users\user\Desktop\"
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
For i = 2 To LastRow
strFile = Cells(i, "A").Value & ".jpg"
If Len(Dir(strPath & strFile, vbNormal)) > 0 Then
With Cells(i, "B")
Set objPic = ActiveSheet.Shapes.AddPicture(Filename:=strPath & strFile, linktofile:=msoFalse, _
savewithdocument:=msoCTrue, Left:=.Left, _
Top:=.Top, Width:=.Width, Height:=.Height)
objPic.LockAspectRatio = msoFalse
End With
Else
Cells(i, "B").Value = "N/A"
End If
Next i
Application.ScreenUpdating = True
End Sub
Bookmarks