распределение фигур/рисунков внутри ячейки с привязкой к ней

[Посетитель 16.01.2022]

Добрый день, для презентаций часто нужно полученные при расчете значения представлять в виде количества фигур (например количество звезд Мишлен)

Макрос для того, чтобы копировать исходную фигуру и вставлять нужное кол-во раз несложно написать.

А вот чтобы они вставлялись напротив цифры с привязкой к ячейке (в ячейке справа от цифры, и чтобы эти фигуры равномерно распределялись внутри ячейки , при необходимости граница столбца расширялась) не знаю как сделать. (необходимо чтобы привязка была к ячейке, а не вставка просто по координатам оси Х и У так как таблицы разные могут быть по размеру)

буду признателен за код, или на ссылки на готовые коды (личный поиск результатов не дал)

[Администратор]

Написал вам два письма на почту с заголовком "Письмо с Форума по VBA, Excel и Word". Написал именно на почту, а не на форум.

Визуально видно, что расстояние между фигурами неодинаковое. Не знаю, как это исправить.

Макрос

Sub Макрос()

    Dim Лист As Worksheet, Лево As Double, Верх As Double, ШиринаРис As Double, РасстМеждуРис As Double
    Dim КоличРис As Long
    Dim i As Long
   
   
    ' Создание ссылки на лист.
    Set Лист = ActiveSheet
   
    ' Копирование фигуры.
    Лист.Shapes("Овал 10").Copy
   
    ' Позиция фигуры слева от листа.
    Лево = Range("H9").Left + 2
   
    ' Позиция фигуры сверху от листа.
    Верх = Range("H9").Top + (Range("H9").Height / 2 - Лист.Shapes("Овал 10").Height / 2)
   
    ' Ширина фигуры.
    ШиринаРис = Лист.Shapes("Овал 10").Width
   
    ' Расстояние между фигурами.
    РасстМеждуРис = 2
   
    ' Количество фигур.
    КоличРис = Range("G9").Value
   
    ' Вставка фигур.
    For i = 1 To КоличРис
        Range("H9").PasteSpecial
        Selection.Left = Лево
        Selection.Top = Верх
        Selection.Placement = xlFreeFloating
        Лево = Лево + ШиринаРис + РасстМеждуРис
    Next i
   
    ' Ширина столбца.
        ' 3.1 подобрано опытным путём.
    Columns("H").ColumnWidth = 3.1 * КоличРис

End Sub