A few words of thanks would be greatly appreciated.

Excel - A Macro to insert pictures in a worksheet

Issue
Solution

Issue

I'm trying to insert pictures in Excel column using macro which takes the file name refrence from the B2 cell and insert picture in A2 cell. For example: if B2 contains N235 then the picture which will be inserted in A2 would be N235.jpg from the given path in Macro. This is working fine EXCEPT when there is no picture in the folder with the the same name as in folder.

I'm getting a runtime error 1004 and Macro stops and can not fill picture after that cell.

Solution

Sub Picture()  
Dim picname As String  

Dim pasteAt As Integer  
Dim lThisRow As Long  

    lThisRow = 2  
      
    Do While (Cells(lThisRow, 2) <> "")  
      
      
        pasteAt = lThisRow  
        Cells(pasteAt, 1).Select 'This is where picture will be inserted  
          
          
        picname = Cells(lThisRow, 2) 'This is the picture name  
          
        present = Dir("C:\Users\Administrator\Desktop\LC\" & picname & ".jpg")  
          
        If present <> "" Then  
              
            ActiveSheet.Pictures.Insert("C:\Users\Administrator\Desktop\LC\" & 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 = 130#  
            .ShapeRange.Rotation = 0#  
            End With  
          
  

        Else  
            Cells(pasteAt, 1) = "No Picture Found"  
        End If  
          
           lThisRow = lThisRow + 1  
    Loop  
      
    Range("A10").Select  
    Application.ScreenUpdating = True  
      
    Exit Sub  
      
ErrNoPhoto:  
    MsgBox "Unable to Find Photo" 'Shows message box if picture not found  
    Exit Sub  
    Range("B20").Select  

End Sub