Sub InsertPic(ByVal PicLocation As String, ByRef dSH As Worksheet, ByRef PicRange As Range, ByVal num As Integer)
''PicLocation - Путь до изображения
''dSH - ссылка лист куда вставляем изображение
''PicRange - ссылка на адрес ячейки куда вставляем изображение
''num - порядковый номер картинки (нужно в случае своей нумерации изображений в нашем случае "UpdatedImage" & num)
Dim sh As Shape
PicRange.Select
''Debug.Print PicRange.MergeArea.Address & " Width=" & PicRange.MergeArea.Width & " Height=" & PicRange.MergeArea.Height
myHeight = PicRange.MergeArea.Height
myWidth = PicRange.MergeArea.Width
Set sh = dSH.Shapes.AddPicture(PicLocation, msoFalse, msoCTrue, 10, 10, -1, -1)
sh.Top = PicRange.Top
sh.Left = PicRange.Left
sh.ScaleHeight 1, 1
sh.ScaleWidth 1, 1
sh.LockAspectRatio = 1
sh.Width = myWidth
sh.Height = myHeight
ratio = (sh.Height / sh.Width)
aspect = (myHeight / myWidth)
If (ratio < aspect) Then sh.Width = myWidth
''Выровнить рисунок по центру
sh.IncrementLeft (PicRange.MergeArea.Width - sh.Width) / 2
sh.IncrementTop (PicRange.MergeArea.Height - sh.Height) / 2
sh.Name = "UpdatedImage" & num
End Sub