Excel VBA Макросы: Вставка фигуры указанное число раз.

[Liar]

Задача: ставим цифру в ячейку и далее (например с помощью кнопки) появляются графические объекты (например, сердце) в количестве равной цифре.

Например написали в ячейку 'B1' число 7 и получаем семь сердец, как показано в файле.
Сердечки должны быть прозрачными с черной окантовкой.
Все фигуры надо сгруппировать (как одна картинка).

[вложение удалено администратором]

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

Макрос

Sub Макрос()
   
    Dim shape As shape, ShapesIndexes(), left_ As Single
    Dim i As Long
   
   
    '1. Создание ячеек в массиве 'ShapesIndexes'.
        ' В него запишем порядковые номера созданных фигур, чтобы потом сгруппировать.
    ReDim ShapesIndexes(1 To Range("B1").Value)
   
    '2. Создание фигур и некоторые другие действия.
   
    ' Расстояние от левой стороны листа до первой фигуры.
    left_ = 9
   
    ' Кол-во витков цикла равно числу, записанному в 'B1'.
    For i = 1 To Range("B1").Value
   
        '1) Вставка на лист фигуры 'Сердце' и назначение фигуре имени "shape".
            ' Далее в коде можно обращаться к фигуре по этому имени.
        Set shape = ActiveSheet.Shapes.AddShape(msoShapeHeart, left_, 6, 16.8, 12.6)
       
        '2) Оформление фигуры. Макрос делает действие, аналогичное этому: контекстная вкладка 'Формат' -
            ' группа 'Стили фигур' - стиль 'Цветной контур, Черный, Темный 1' (это первый стиль).
        shape.ShapeStyle = msoShapeStylePreset1
       
        '3) Запоминаем порядковый номер созданной фигуры.
            ' Порядковый номер будет совпадать с кол-вом рисунков на листе.
        ShapesIndexes(i) = ActiveSheet.Shapes.Count
       
        '4) Задаём, расстояние для следующей фигуры от левой стороны листа до фигуры.
        left_ = left_ + 16.8 + 9
       
    Next i
   
    '3. Группировка созданных фигур.
    ActiveSheet.Shapes.Range(ShapesIndexes()).Group
   
End Sub

[свернуть]

[Liar]

Большое, пребольшое спасибо!

[Liar]

Как присвоить фигуре определенную ячейку.
Я допустим хочу, чтобы сердечки появлялись в определенной ячейке, например, B7.

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

1. В этом пункте укажите левое положение ячейки:
' Расстояние от левой стороны листа до первой фигуры.
left_ = 9

' Расстояние от левой стороны листа до первой фигуры.
left_ = Range("B7").Left


2. В этом пункте укажите верхнее положение ячейки:
'1) Вставка на лист фигуры 'Сердце' и назначение фигуре имени "shape".
    ' Далее в коде можно обращаться к фигуре по этому имени.
Set shape = ActiveSheet.Shapes.AddShape(msoShapeHeart, left_, 6, 16.8, 12.6)

'1) Вставка на лист фигуры 'Сердце' и назначение фигуре имени "shape".
    ' Далее в коде можно обращаться к фигуре по этому имени.
Set shape = ActiveSheet.Shapes.AddShape(msoShapeHeart, left_, Range("B7").Top, 16.8, 12.6)


P.S. Рисунок фактически не находится внутри ячейки, а находится над ячейкой. Поэтому прямой привязки между ячейкой и рисунком нет. То есть рисунок просто находится на листе, в каком-либо месте листа, сверху и создаётся впечатление, что рисунок находится в ячейке. Зная ячейку, в VBA нет инструментов, чтобы узнать, есть над ячейкой рисунок или нет. Для этого нужно писать код, чтобы в цикле просматривать все рисунки и смотреть, находится рисунок над заданной ячейкой или нет.
Но есть инструменты, как узнать, над какой ячейкой находится рисунок, используя свойства рисунка: BottomRightCell, TopLeftCell.

[Liar]

Спасибо большое!