'   если путь надо указать статичный - вместо диалога прописываем одну строку
    '   sPicsPath = "C:\images\"

sPicsPath = ThisWorkbook.Path

Option Explicit
 
Sub InsertPictureByVal()
    Dim sPicsPath As String
    Dim sPicName As String, sPFName As String, sSpName As String
    Dim llastr As Long, lr As Long
    Dim oShp As Shape
    Dim zoom As Double
 
    'выбираем путь к папке с картинками
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выбрать папку с картинками"       'заголовок окна диалога
        .ButtonName = "Выбрать папку"
        .Filters.Clear                              'очищаем установленные ранее типы файлов
        .InitialFileName = ThisWorkbook.Path        'назначаем первую папку отображения
        .InitialView = msoFileDialogViewLargeIcons  'вид диалогового окна
        If .Show = 0 Then Exit Sub               'показываем диалог
        sPicsPath = .SelectedItems(1) 'считываем путь к папке
    End With
    '   если путь надо указать статичный - вместо диалога прописываем одну строку
    '   sPicsPath = "C:\images\"
 
 
    'проверяем, есть ли слеш после пути к папке
    'если нет - добавляем, иначе путь к картинке будет неверный
    If Right(sPicsPath, 1) <> Application.PathSeparator Then
        sPicsPath = sPicsPath & Application.PathSeparator
    End If
    'определяем последнюю ячейку по столбцу с именами картинок
    llastr = Cells(Rows.Count, 2).End(xlUp).Row
    'если кроме шапки в столбце с именами картинок ничего нет
    If llastr < 2 Then
        Exit Sub
    End If
    'цикл по столбцу с именами картинок
    For lr = 2 To llastr
        sPicName = Cells(lr, 2).Value
        'проверяем наличие картинки в папке
        sPFName = sPicsPath & sPicName
        If Dir(sPFName, 16) <> "" And sPicName <> "" Then
            'в эту ячейку вставляем картинку
            With Cells(lr, 3)
 
                'задаем картинке уникальный адрес,
                'привязанный к адресу ячейки
                sSpName = "_" & .Address(0, 0) & "_autopaste"
                'если картинка уже есть - удаляем её
                Set oShp = Nothing
                On Error Resume Next
                Set oShp = ActiveSheet.Shapes(sSpName)
                If Not oShp Is Nothing Then
                    oShp.Delete
                End If
                On Error GoTo 0
                'вставляем выбранную картинку
                Set oShp = ActiveSheet.Shapes.AddPicture(sPFName, False, True, .Left + 1, .Top + 1, -1, -1)
                'определяем размеры картинки в зависимости от размера ячейки
                zoom = Application.Min(.Width / oShp.Width, .Height / oShp.Height)
                oShp.Height = oShp.Height * zoom - 2
                'переименовываем вставленную картинку(чтобы потом можно было заменить)
                oShp.Name = sSpName
                oShp.OnAction = "ClickResizeImage"
            End With
        End If
    Next
End Sub

=СЦЕПИТЬ(ПОДСТАВИТЬ(ЯЧЕЙКА("имяфайла");СЖПРОБЕЛЫ(ЛЕВСИМВ(ПРАВСИМВ(ПОДСТАВИТЬ(ЯЧЕЙКА("имяфайла");"\";ПОВТОР(" ";100));100);100));"");A1;".png")

Sub InsertImage()
    Dim SHP As Shape, fName As String, Cel As Range
    Set Cel = Application.InputBox("select cell for image placement & click on OK", "", , , , , , 8)
    fName = Application.GetOpenFilename(Title:="Select image", FileFilter:="Images (*.gif;*.jpg;*.jpeg;*.bmp;*.png),*.gif;*.jpg;*.jpeg;*.bmp;*.png")
    Cel.Select
    ActiveSheet.Pictures.Insert(fName).Select
    Set SHP = Selection.ShapeRange.Item(1)
    Call PlaceImage(Cel, SHP)
    SHP.OnAction = "ClickResizeImage"               '(assign macro)
    Cel.Select
End Sub
Sub PlaceImage(Cel As Range, SHP As Shape)
    Dim W As Double, H As Double, L As Double, T As Double
    Cel.Select: W = Cel.Width: H = Cel.Height: L = Cel.Left: T = Cel.Top
    With SHP
        .LockAspectRatio = msoTrue
        .Width = W
        If .Height > H Then .Height = H
        .Left = L + (W - SHP.Width) / 2
        .Top = T + (H - SHP.Height) / 2
    End With
End Sub
Sub ClickResizeImage()
    Dim SHP As Shape, Cel As Range, W As Double, H As Double, L As Double, T As Double
    Set SHP = ActiveSheet.Shapes(Application.Caller)
    Set Cel = SHP.TopLeftCell
    Cel.Select: W = Cel.Width: H = Cel.Height: L = Cel.Left: T = Cel.Top
    If SHP.Width < W Or SHP.Height < H Then SHP.Width = W * 5 Else Call PlaceImage(Cel, SHP)
End Sub