Option Explicit
' contextures.com/xlcomments03.html

Public Sub Komus_Article_Pics()
    
    Dim rng As Range
    Dim lArt As Long
    Dim sPict, sPict2 As String
    Dim att As VbMsgBoxResult

'    Application.ScreenUpdating = False

'    ЦИКЛ - работа с выделенным диапазоном
    For Each rng In Selection

'        Проверка корректности выделения
        On Error Resume Next
            lArt = Application.WorksheetFunction.Clean(Trim(rng.Value))
            If Err = 13 Then    ' "Несоответствие типа"
                att = MsgBox(prompt:="Выделять только №№ артикулов!", _
                        Buttons:=vbCritical, _
                        Title:="Комус")
                Exit Sub
            End If
        On Error GoTo 0
    
'        для отладки, удаление уже существующих комментариев
        If Not rng.Comment Is Nothing Then
            rng.Comment.Delete
        End If
        
        sPict = "http://www.komus.ru/photo/normal/" & lArt & "_1.jpg"
        sPict2 = "http://www.komus.ru/photo/normal/!" & lArt & "_1.jpg"
        
'        фото - комментарий
        With rng.AddComment
            .Visible = False
            .Text "" & lArt
'            .Text "№ " & lArt & Chr(10) & _
'                Left(rng.Offset(rowOffset:=0, columnOffset:=1).Value, 25)
            
            With .Shape
                With .Fill
                    .ForeColor.RGB = RGB(255, 255, 255) 'белый
                    .Transparency = 0#  ' непрозрачный

'                обработка ошибочных №№ !артикулов...
                    On Error Resume Next
                        .UserPicture sPict
                        If Err = 7 Then ' "Не хватает памяти"
                            sPict = sPict2
'                            пометка серым проблемных артикулов
                            rng.Interior.Color = RGB(192, 192, 192)
                            .UserPicture sPict
                        End If
                    On Error GoTo 0
                End With
                
                With .TextFrame.Characters.Font
                    .Name = "Arial Narrow"
                    .Size = 10
                    .Bold = True
                    .ColorIndex = 1 ' чёрный - 1, синий - 5
                End With
                
                .ScaleWidth 1, msoFalse, msoScaleFromTopLeft
                .ScaleHeight 2, msoFalse, msoScaleFromTopLeft
            End With
            
            .Shape.Height = 150     ' для экранного масштаба 96 т/д
            .Shape.Width = 150
'            .Shape.Height = 120    ' для экранного масштаба 120 т/д
'            .Shape.Width = 120

        End With
    
'        добавление гипессылок в артикулы
        rng.Hyperlinks.Add Anchor:=rng, Address:= _
        "http://www.komus.ru/item.php?itemID=" & lArt
    
    Next rng

'    Application.ScreenUpdating = True

End Sub