Sub AddImage()
    Dim ImaFile$
    Dim w, ww As Long
    Dim h, hh As Long
    Dim wsAct As Worksheet, rCellAct As Range
    'считываем путь к файлу картинки
    If Selection.Cells.Count > 1 Then Exit Sub
    With Application.FileDialog(msoFileDialogFilePicker)
        .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        ImaFile = .SelectedItems(1)
    End With
                        
        w = LoadPicture(ImaFile).Width       'размер
        h = LoadPicture(ImaFile).Height
        If h / w > w / h Then
        ww = 2
        hh = h / w * 3.8
        Else
        ww = 2
        hh = w / h * 3.8
        End If
        
    On Error GoTo nexterr
    Set wsAct = ThisWorkbook.ActiveSheet
    Set rCellAct = ActiveCell
    rCellAct.ClearComments
    With rCellAct.AddComment.Shape   'заливаем картинку
        .Fill.UserPicture (ImaFile)
        .ScaleWidth ww, msoFalse, msoScaleFromTopLeft
        .ScaleHeight hh, msoFalse, msoScaleFromTopLeft 'корректируем размер
    End With
    wsAct.Hyperlinks.Add rCellAct, ImaFile, , , "Cover"
    Exit Sub
nexterr:
    MsgBox "Можно выбирать только изображения!", vbCritical, "Ошибка"
    ActiveCell.ClearComments
      
    
End Sub