I'm facing 2 issues in using below code. 1st, suppose the image names are in column B from B2 to B11. Now, if the image against the image name in B7 is missing, then there only loop stops (it doesnt go till last row) and images of B8, B9 etc doesnt get pasted, even when they were there in the base image folder. So what i need is, i will keep a image with the name "NA" in my image folder, and i need if at any place image is not available, it will paste NA image against the same and move on to the last row.
2nd, after this working is done, how can i save my file or make changes in such a way that, even if i delete the base image folder or move the base image folder, images still reflect in excel. As of now, if i move the folder, images disappear.
Please help
Sub Picture()
Dim picname As String
Dim pasteAt As Integer
Dim lThisRow As Long
lThisRow = 2
Do While (Cells(lThisRow, 2) <> "")
'Range("A6").Select 'This is where picture will be inserted
pasteAt = Cells(lThisRow, 3)
Cells(pasteAt, 1).Select 'This is where picture will be inserted
'Dim picname As String
'picname = Range("B6") 'This is the picture name
picname = Cells(lThisRow, 2) 'This is the picture name
ActiveSheet.Pictures.Insert("C:\Users\vbayat\My Documents\vidabayat\re-market\" & picname & ".jpg").Select 'Path to where pictures are stored
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This resizes the picture
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Selection
'.Left = Range("A6").Left
'.Top = Range("A6").Top
.Left = Cells(pasteAt, 1).Left
.Top = Cells(pasteAt, 1).Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 100#
.ShapeRange.Width = 80#
.ShapeRange.Rotation = 0#
End With
