Как присвоить имя автофигуре?

[Град]

Коллеги, есть ли способ присваивания нужного имени автофигуре?
А то, что бы узнать какое имя дано поумолчанию, надо записать какой-нидь макрос. Очень не удобно(((

и ещё:
можно ли написать такой макрос, чтобы он сравнивал имя автофигуры , искал это имя в столбце и найдя изменил какое-нидь cвойство автофигуры (цвет, размер, текст написал и т.п) в зависимости от данных справа от этой ячейки.

Наверное сложно объясняю.
присмер:
Есть автофигура с названием "стол". Макрос ищет в таблице(столбце) ячейку св которой написано "Стол" и если справа стоит "0", то автофигура становится красной, если от 1 до 5, то она увеличивается в два раза и т.п.

Заранее благодарю

[EducatedFool]

Коллеги, есть ли способ присваивания нужного имени автофигуре?

Конечно есть. Свойство Name автофигуры доступно для записи.

можно ли написать такой макрос, чтобы он сравнивал имя автофигуры , искал это имя в столбце и найдя изменил какое-нидь cвойство автофигуры (цвет, размер, текст написал и т.п) в зависимости от данных справа от этой ячейки

Написать можно любой макрос... В частности, с автофигурой можно очень много чего сделать - у неё много всяких свойств.

См. вложение:

[tolikman]

еще имя фигуре можно присвоить не макросом, просто выбрать нужную фигуру, в верхнем левом углу вместо "прямоугольник 1" написать "стол" и нажать enter, и все - shapes("стол") вернет нужную фигуру.

[Град]

Большое спасибо!
Посмотрел.. Работает. Буду разбираться!
Думаю вопросы возникнут по ходу...
Спасибо

[Град]

Можно сделать так, чтобы не нужно присваивать Номер фигуре?
Что бы достаточно было имени.(В столбце писать не номер её, а имя)?

Выделил фигуру, в левом ферхнем углу присвоил имя, затем в столбце написал это имя, а слева в ячейки процедуру (1 или 2 или т.д), нажал кнопку и процедура выполнилась.

Спасибо!

[EducatedFool]

Замените процедуру ChangeShapeProperties на следующую, после чего вместо номеров автофигур в диапазоне "b3:b14" укажите имена автофигур (регистр не учитывается)

Sub ChangeShapeProperties()
    On Error Resume Next
    Dim sh As Shape, ra As Range, ce As Range
    Set ra = ActiveSheet.Range("b3:b14") ' задаёт диапазон ячеек с именами автофигур
    For Each sh In ActiveSheet.Shapes
        For Each ce In ra.Cells
            If StrComp(sh.Name, ce.Value, vbTextCompare) = 0 Then
                    ShapeProperty = ce.Offset(, 1).Value
                    ApplyShapeProperty sh, ShapeProperty
            End If
        Next ce
    Next sh
End Sub

[Град]

Супер! Работает! Большое спасибо!