Sub ÂñòàâêàÊàðòèíîê()
'
' âûäåëåíèå ïåðâîãî ñòîëáöà è ðåäàêòèðîâàíèå
Columns("A:B").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
'.Font.Bold = True
.Font.Size = 9
End With


' Èçìåíåíèå âûñîòû è øèðèíû ñòîëáöà Â
Columns("B:B").Select
Selection.RowHeight = 50
Selection.ColumnWidth = 15
'-------------------------------------

Dim a As String
' öèêë ïîêà íå êîí÷àòñÿ çíà÷åíèÿ
20 While ActiveSheet.Cells(i + 1, 1).Value <> ""
i = i + 1
b = ActiveSheet.Cells(i, 1).Value
'------------------------------
' çàìåíà ñèìâîëîâ
b = Application.Substitute(b, "/", "_", 1)
b = Application.Substitute(b, "À", "A", 1)
b = Application.Substitute(b, "Â", "B", 1)
b = Application.Substitute(b, "Ó", "", 1)
'------------------------------
If Dir("\\smbsrv\dshare\ÔîòîÍîìåíêëàòóðû\ÔÎÒÎ\" & b & ".jpg") = "" Then GoTo Error404
a = "\\smbsrv\dshare\ÔîòîÍîìåíêëàòóðû\ÔÎÒÎ\" & b & ".jpg"
' âûäåëåíèå âòîðîãî ñòîëáöà, ÷òîáû âñòàâëÿòü òóäà
Cells(i, 2).Select
Dim MyPicture As Excel.Picture
Set MyPicture = ActiveSheet.Shapes.AddPicture("\\smbsrv\dShare\ôîòîíîìåíêëàòóðû\ôîòî\" & b & ".jpg", False, True, -1, -1, -1, -1)
MyPicture.ShapeRange.Height = 50
' ïåðåìåùàòü è ñîðòèðîâàòü âìåñòå ñ ÿ÷åéêàìè
MyPicture.Placement = xlMoveAndSize
MyPicture.PrintObject = True

Wend
GoTo 10
Error404:
Cells(i, 2).Value2 = "ÍÅÒ ÔÎÒÎ"
GoTo 20
10

Sub ВставкаКартинок()
Attribute ВставкаКартинок.VB_ProcData.VB_Invoke_Func = "q\n14"
'
' выделение первого столбца и редактирование
Columns("A:B").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
'.Font.Bold = True
.Font.Size = 9
End With


' Изменение высоты и ширины столбца В
Columns("B:B").Select
Selection.RowHeight = 50
Selection.ColumnWidth = 15
'-------------------------------------

Dim a As String
' цикл пока не кончатся значения
20 While ActiveSheet.Cells(i + 1, 1).Value <> ""
i = i + 1
b = ActiveSheet.Cells(i, 1).Value
'------------------------------
' замена символов
b = Application.Substitute(b, "/", "_", 1)
b = Application.Substitute(b, "А", "A", 1)
b = Application.Substitute(b, "В", "B", 1)
b = Application.Substitute(b, "У", "", 1)
'------------------------------
If Dir("\\smbsrv\dshare\ФотоНоменклатуры\ФОТО\" & b & ".jpg") = "" Then GoTo Error404
a = "\\smbsrv\dshare\ФотоНоменклатуры\ФОТО\" & b & ".jpg"
' выделение второго столбца, чтобы вставлять туда
Cells(i, 2).Select
Dim MyPicture As Excel.Picture
Set MyPicture = ActiveSheet.Shapes.AddPicture("\\smbsrv\dShare\фотономенклатуры\фото\" & b & ".jpg", False, True, -1, -1, -1, -1)
MyPicture.ShapeRange.Height = 50
' перемещать и сортировать вместе с ячейками
MyPicture.Placement = xlMoveAndSize
MyPicture.PrintObject = True

Wend
GoTo 10
Error404: