VBA Beginner: Import multiple pictures

[VBAChild]

Hallo everyone! I'm a total VBA noob (I started learning yesterday)... I need to import something like 450 images into Excel.
I have a column with a series of Type Marks (CHA001, CHA002, STO001....) starting from cell A1. I need to import images with the same names (CHA001.jpg, CHA002.jpg, STO001.jpg...) into the neighbouring cells, in column B.

I've tried a couple of different scripts, however, I don't have all the images and I think this is why my script is failing. I'm looking for a way to make VBA skip the cells which have no corresponding image and move on to the next one.

One option:

Sub AddImages()

Dim i As Long
Dim ffePic As Picture
Dim imgLocation As String
Dim typeMark As String
   
Application.EnableEvents = False
Application.ScreenUpdating = False

For i = 2 To 459

typeMark = Worksheets("Sheet1").Cells(i, 1).Value
imgLocation = "C:\Users\Raina Armstrong\Pictures\JPEG\" & typeMark & ".jpg"

With Worksheets("Sheet1").Cells(i, 2)
Set ffePic = ActiveSheet.Pictures.Insert(ImageLocation)
Set CellLocation = ActiveSheet.Cells(i, 2)

    ffePic.Top = CellLocation.Top + (CellLocation.Height / 2) - (ffePic.Height / 2)
    ffePic.Left = CellLocation.Left + (CellLocation.Width / 2) - (ffePic.Width / 2)
    ffePic.ShapeRange.LockAspectRatio = msoTrue
    ffePic.Placement = xlMoveAndSize
    ffePic.ShapeRange.Height = 100

End With

Next

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Another:

Sub AddImages()

For Each r In rng
    fName = Dir(fPath)
    Do While fName <> ""
        If fName = r.Value Then
            With ActiveSheet.Pictures.Insert(fPath & fName)
                .ShapeRange.LockAspectRatio = msoTrue
                .Top = r.Offset(0, -2).Top
                .Left = r.Offset(0, -2).Left
                If .ShapeRange.Width > Columns(2).Width Then .ShapeRange.Width = Columns(2).Width
                Rows(r.Row).RowHeight = .ShapeRange.Height
            End With
        End If
        fName = Dir
    Loop
Next r

Application.ScreenUpdating = True
Application.ScreenUpdating = True

End Sub

Any help here would be greatly appreciated!

 

[John_w]

In the first macro add these lines on either side of the With .... End With block:

If Dir(imgLocation) <> vbNullString Then


End If

In this line:

Set ffePic = ActiveSheet.Pictures.Insert(ImageLocation)

ImageLocation is undefined - change it to imgLocation. Always use Option Explicit so the compiler finds these type of errors.