А поможет?  :D

https://www.excelworld.ru/forum/10-54239-1
но не стоит надеяться что приложение предназначено для такой визуализации.

ну это почти то, но там не понятно как потом редактировать (( да и с макросами я не работал ни когда, я думал может штатно как-то можно, как в примерах когда в описания картинку вставляют. Мне бы так же только наоборот )))) А может вы знаете как можно привязать картинку к ячейки, чтобы можно было потом эту картинку таскать куда угодно с сохранением привязки к ячейки? Может ещё так прокатит, а то у меня идеи как это без кода и при этом легко редактируемо сделать вообще закончились ((((

kot2012, здравствуйте.
Можно попробовать вот так, только не при наведении на картинку, а при клике.
См. вложение.

Описание меняется в свойстве Caption объекта Label1.
Положение меняется в свойствах Left и Top объекта Label1.

Подскажите пожалуйста, на что он ругается? Я просто скопировал весь код в новый файл без изменений, и он перестал работать

Потеря Undo происходит при выполнении любого макроса. В данном случае можно минимизировать сброс Undo, к примеру, используя повторное нажатие на картинку с проверкой имени для скрытия описания. Это позволит уйти от использования Worksheet_SelectionChange.

А мне видится реализация довольно лаконичной (для моего варианта).
Независимо от количества картинок на листе, присвоить всем одну процедуру. На другой лист получить в столбик имена всех картинок и рядом уже прописывать свои данные (характеристики или что там будет у ТС), ну и, соответственно, выводить описание по имени картинки в единственный label. Естественно, всё описанное делается программно.

Нет, я про свой метод.))

Так я это и предложил, в описании реализации своего варианта   .

Для специалиста это решаемо.

Это понятно, что спец сделает, но я к таким не отношусь к сожалению, поэтому и обратился за помощью  

Народ, помогите пожалуйста! Не пойму почему размер по ширине метка не изменяет (((
Sub ОписаниеКартинок()
   Dim pic As Shape, lbl As OLEObject
   Dim imgID As String
   Dim desc As String
   Dim additionalInfoC As String
   Dim additionalInfoD As String
   Dim additionalInfoE As String
   Dim rowIndex As Long
   Dim maxWidth As Double
   maxWidth = 300 ' Максимальная ширина метки

   ' Получаем ссылку на картинку
   Set pic = ActiveSheet.Shapes(Application.Caller)

   ' Проверяем наличие Label1 на активном листе
   On Error Resume Next
   Set lbl = ActiveSheet.OLEObjects("Label1")
   On Error GoTo 0

   If lbl Is Nothing Then
       MsgBox "Label1 не найдена на активном листе", vbExclamation
       Exit Sub
   End If

   If Not TypeOf lbl.Object Is MSForms.Label Then
       MsgBox "Объект Label1 не является меткой!", vbExclamation
       Exit Sub
   End If

   ' Получаем метку
   Dim lblLabel As MSForms.Label
   Set lblLabel = lbl.Object

   ' Получаем ID картинки
   imgID = Split(pic.Name, "_")(1)
   Debug.Print "imgID: " & imgID

   ' Ищем строку по ID
   rowIndex = FindRowByID(imgID, "Данные")

   If rowIndex > 0 Then
       desc = Sheets("Данные").Range("B" & rowIndex).Value
       additionalInfoC = Sheets("Данные").Range("C" & rowIndex).Value
       additionalInfoD = Sheets("Данные").Range("D" & rowIndex).Value
       additionalInfoE = Sheets("Данные").Range("E" & rowIndex).Value
       
       desc = "Описание: " & desc & vbCrLf & _
              "Дополнительно C: " & additionalInfoC & vbCrLf & _
              "Дополнительно D: " & additionalInfoD & vbCrLf & _
              "Дополнительно E: " & additionalInfoE
       
       desc = Replace(desc, ",", vbCrLf) ' Меняем запятую на перенос строки

       ' Проверяем, отличается ли текст метки от нового текста
       If lblLabel.Caption <> desc Then
           lblLabel.Caption = desc

           ' Отключаем автоматическую подгонку высоты
           lblLabel.AutoSize = False
           
           ' Устанавливаем ширину метки, и если она больше maxWidth, устанавливаем maxWidth
           lblLabel.Width = Application.WorksheetFunction.Min(lblLabel.Width, maxWidth)
           
           ' Устанавливаем высоту
           lblLabel.Height = Application.WorksheetFunction.Max(lblLabel.Height, 20)

           ' Изменяем шрифты и цвет заливки
           With lblLabel.Font
               .Name = "Arial"
               .Size = 11
               .Bold = False
           End With

           ' Устанавливаем цвет заливки
           lblLabel.BackColor = RGB(255, 255, 0)

           ' Получаем координаты для размещения Label
           With pic
               Dim picRight As Double
               Dim picBottom As Double
               picRight = .Left + .Width
               picBottom = .Top + .Height - 15
           End With
           
           lblLabel.Left = picRight
           lblLabel.Top = picBottom
           
           lbl.Visible = True
       End If
   Else
       MsgBox "ID не найден: " & imgID & vbNewLine & "Проверьте наличие данных на листе 'Данные'."
   End If

End Sub


Function FindRowByID(imgID As String, sheetName As String) As Long
   Dim ws As Worksheet

   ' Проверяем, существует ли sheetName
   On Error Resume Next
   Set ws = Sheets(sheetName)
   On Error GoTo 0

   If ws Is Nothing Then
       MsgBox "Лист '" & sheetName & "' не найден", vbExclamation
       FindRowByID = -1
       Exit Function
   End If

   Dim lastRow As Long
   lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' Находим последнюю строку в столбце A
   
   Dim i As Long
   For i = 1 To lastRow
       If ws.Cells(i, 1).Value = imgID Then ' Предполагается, что ID находится в столбце A
           FindRowByID = i ' Возвращаем номер строки, где найден ID
           Exit Function
       End If
   Next i
   
   FindRowByID = -1 ' Если не найден, возвращаем -1
End Function

Всем доброго! В общем всё получилось! ) Огромная благодарность и отдельное спасибо за наставление на путь истинный - asesja! В общем выкладываю то, что у меня получилось, надеюсь кому то подойдет данный шаблон! Но если будут рекомендации по коду буду только рад! Всем спасибо за помощь и поддержку!