---

Sub InsertPicturesFromURLs()
    Dim cell As Range
    Dim Pic As Object
    Dim URL As String
    Dim TargetCell As Range
    
    ' --- НАСТРОЙКИ (измените под себя) ---
    ' Укажите диапазон с вашими ссылками (например, "A2:A10")
    Set Rng = ActiveSheet.Range("A2:A10")
    ' ---------------------------------------
    
    Application.ScreenUpdating = False
    
    For Each cell In Rng
        URL = cell.Value
        
        If URL <> "" Then
            ' Вставляем картинку справа от ячейки со ссылкой (сдвиг на 1 столбец)
            Set TargetCell = cell.Offset(0, 1)
            
            ' Очищаем старую картинку, если она там уже есть
            On Error Resume Next
            TargetCell.Parent.Shapes("pic_" & cell.Row).Delete
            On Error GoTo 0
            
            ' Вставляем новую картинку по URL
            Set Pic = ActiveSheet.Pictures.Insert(URL)
            
            With Pic
                .Name = "pic_" & cell.Row
                .ShapeRange.LockAspectRatio = msoTrue
                ' Подгоняем размер под ячейку (с отступом)
                .Top = TargetCell.Top + 2
                .Left = TargetCell.Left + 2
                .Width = TargetCell.Width - 4
                If .Height > TargetCell.Height - 4 Then .Height = TargetCell.Height - 4
            End With
        End If
    Next cell
    
    Application.ScreenUpdating = True
    
    MsgBox "Готово!"
End Sub