Sub пп()
    'путь к папке с картинками 
    Const sPicsPath As String = "C:\Users\.....\"
    Dim sPicName As String, sPFName As String, sSpName As String
    Dim oShp As Shape
    Dim zoom As Double
    Application.ScreenUpdating = False
    Dim sh As Worksheet, cell As Range
    Set sh = ActiveSheet
        Set cell = sh.Range("A:L").Find("Генеральный директор*")
    sPicName = "1.png" 'ИМЯ ВАШЕЙ ПОДПИСИ И ПЕЧАТИ
    'если имя картинки не задано
    If sPicName = "" Then
        Exit Sub
    End If
    'проверяем наличие картинки в папке
    sPFName = sPicsPath & sPicName
    If Dir(sPFName, 16) = "" Then
        Exit Sub
    End If
    'в эту ячейку вставляем картинку
    If Not cell Is Nothing Then
    With sh.Cells(cell.Row - 1, cell.Column + 3)
        On Error Resume Next
        'задаем картинке уникальный адрес,
        'привязанный к адресу ячейки
        sSpName = "_" & .Address(0, 0) & "_autopaste"
        'если картинка уже есть - удаляем её
        Set oShp = ActiveSheet.Shapes(sSpName)
        If Not oShp Is Nothing Then
            oShp.Delete
        End If
        'вставляем выбранную картинку
        Set oShp = ActiveSheet.Shapes.AddPicture(sPFName, False, True, .Left + 1, .Top + 1, -1, -1)
        'определяем размеры картинки в зависимости от размера ячейки
        zoom = Application.Min(.Width / oShp.Width, .Height / oShp.Height)
        'переименовываем вставленную картинку(чтобы потом можно было заменить)
        oShp.Name = sSpName
    End With
    End If
Application.ScreenUpdating = True
End Sub