Задача: ставим цифру в ячейку и далее (например с помощью кнопки) появляются графические объекты (например, сердце) в количестве равной цифре.
Например написали в ячейку '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
Большое, пребольшое спасибо!
Как присвоить фигуре определенную ячейку.
Я допустим хочу, чтобы сердечки появлялись в определенной ячейке, например, 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.
Спасибо большое!