Code to attach pictures to an excel sheet

[sully3868]

Hello, I have this code below to add pictures to an excel file. The only issue with it is that when its looking down through the list and matching the picture name from the excel sheet to the folder, if there is no match the code stops. Is there an easy way to make it so that if there is no match, the code will jump over that picture and go to the next?





Private Sub CommandButton1_Click()

Dim animal_pic As Picture

Dim pic_location As String

Dim animal_name As String

For i = 2 To 329

animal_name = Worksheets("1").Cells(i, 1).Value

pic_location = "W:\thumbnails\" & Worksheets("1").Cells(i, 1).Value & ".jpg"



With Worksheets("1").Cells(i, 16)

Set animal_pic = ActiveSheet.Pictures.Insert(pic_location)



animal_pic.Top = .Top

animal_pic.Left = .Left

animal_pic.ShapeRange.LockAspectRatio = msoFalse

animal_pic.Placement = xlMoveAndSize

animal_pic.ShapeRange.Width = 120

animal_pic.ShapeRange.Height = 90

End With

Next

Worksheets("1").Cells(1, 1).Select

End Sub

 

[Fluff]

How about

Private Sub CommandButton1_Click()

Dim animal_pic As Picture

Dim pic_location As String

Dim animal_name As String

For i = 2 To 329

animal_name = Worksheets("1").Cells(i, 1).Value

pic_location = "W:\thumbnails\" & Worksheets("1").Cells(i, 1).Value & ".jpg"

If Dir(pic_location) <> "" Then

With Worksheets("1").Cells(i, 16)

Set animal_pic = ActiveSheet.Pictures.Insert(pic_location)



animal_pic.Top = .Top

animal_pic.Left = .Left

animal_pic.ShapeRange.LockAspectRatio = msoFalse

animal_pic.Placement = xlMoveAndSize

animal_pic.ShapeRange.Width = 120

animal_pic.ShapeRange.Height = 90

End With
End If
Next

Worksheets("1").Cells(1, 1).Select

End Sub