Зависание Excel при выполнении макроса подстановки картинок

Sub фото()
Dim Foto_put As String
Dim lLastRow As Long
 
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
 
For i = 2 To lLastRow
    Foto_put = "C:\Users\iaks\Desktop\Foto-bank\FSB\" & Cells(i, 3).Value & ".jpg"
    ВставитьКартинку Cells(i, 11), Foto_put, True, True, True
    
    
    Next i
 
 
 
End Sub
Function ВставитьКартинку(ByRef PicRange As Range, ByVal PicPath As String, _
                     Optional ByVal AdjustWidth As Boolean, _
                     Optional ByVal AdjustHeight As Boolean, _
                     Optional ByVal AdjustPicture As Boolean = False)
    ' ==========  функция получает в качестве параметров:  ====================
   ' PicRange - прямоугольный диапазон ячеек, поверх которого будет расположено изображение
   ' PicPath - полный путь к файлу картинки (файл в формате JPG, BMP, PNG, и т.д.)
   ' AdjustWidth - если TRUE, то включен режим подбора ширины (подгонка по высоте)
   ' AdjustHeight - если TRUE, то включен режим подбора высоты (подгонка по ширине)
   ' AdjustPicture - если TRUE, то подгоняются размеры картинки под ячейку,
   '                 если FALSE (по умолчанию), то изменяются размеры ячейки
   ' [url]http://excelvba.ru/code/PastePictures[/url] - ссылка на оригинал статьи
 
    On Error Resume Next: Application.ScreenUpdating = False
    ' вставка изображения на лист
   Dim ph As Picture: Set ph = PicRange.Parent.Pictures.Insert(PicPath)
    ' совмещаем левый верхний угол ячейки и картинки
   ph.Top = PicRange.Top: ph.Left = PicRange.Left
 
    K_picture = ph.Width / ph.Height    ' вычисляем соотношение размеров сторон картинки
   K_PicRange = PicRange.Width / PicRange.Height    ' вычисляем соотношение размеров сторон диапазона ячеек
 
    If AdjustPicture Then    ' ПОДГОНЯЕМ РАЗМЕРЫ ИЗОБРАЖЕНИЯ под ячейку (оптимальный вариант)
 
        ' если AdjustWidth=TRUE, то высоту не трогаем - изменяем ширину
       If AdjustWidth Then ph.Width = PicRange.Width: ph.Height = ph.Width / K_picture
 
        ' если AdjustHeight=TRUE, то ширину не трогаем - изменяем высоту
       If AdjustHeight Then ph.Height = PicRange.Height: ph.Width = ph.Height * K_picture
 
        ' AdjustWidth=TRUE и AdjustHeight=TRUE: вписываем картинку в ячейку (без соблюдения пропорций)
       If AdjustWidth And AdjustHeight Then ph.Width = PicRange.Width: ph.Height = PicRange.Height
 
 
    Else    ' ИЗМЕНЯЕМ РАЗМЕРЫ ЯЧЕЙКИ под размеры изображения (нежелательно при вставке НЕСКОЛЬКИХ картинок...)
 
        If AdjustWidth Then    ' если AdjustWidth=TRUE, то высоту не трогаем - изменяем ширину
           PicRange.Cells(1).ColumnWidth = PicRange.Cells(1).ColumnWidth * ph.Width / PicRange.Cells(1).Width
            While Abs(PicRange.Cells(1).Width - ph.Width) > 0.1    ' точный подбор ширины ячейки
               PicRange.Cells(1).ColumnWidth = PicRange.Cells(1).ColumnWidth - 0.2 * (PicRange.Cells(1).Width - ph.Width)
            Wend
        End If
 
        If AdjustHeight Then    ' если AdjustHeight=TRUE, то ширину не трогаем - изменяем высоту
           PicRange.Cells(1).RowHeight = PicRange.Cells(1).RowHeight * ph.Height / PicRange.Cells(1).Height
            While Abs(PicRange.Cells(1).Height - ph.Height) > 0.1    ' точный подбор высоты ячейки
               PicRange.Cells(1).RowHeight = PicRange.Cells(1).RowHeight - 0.2 * (PicRange.Cells(1).Height - ph.Height)
            Wend
        End If
 
    End If
End Function

Public Const FLDR$ = "C:\Users\iaks\Desktop\Foto-bank\FSB\"
Public Const PART& = 300 'по сколько фоток вставлять
 
Public lastRow&, j&, i&, Foto_put$

Private Sub CommandButton1_Click()
If lastRow = 0 Then '1-st pass
  lastRow = Cells(Rows.Count, 1).End(xlUp).Row
  i = 2
  CommandButton1.Width = 160
End If
If i > lastRow Then CommandButton1.Enabled = False: Exit Sub
If i + PART > lastRow Then j = lastRow Else j = i + PART
CommandButton1.Caption = i & " - " & j & " из " & lastRow
For i = i To j
  Foto_put = FLDR & Cells(i, 3).Value & ".jpg"
  ВставитьКартинку Cells(i, 11), Foto_put, True, True, True
Next
End Sub