Создание фигуры по условию

[GAS1979]

Я запускаю макрос из ячейки, с текстом.
Идет проверка, если фигура с таким именем (как содержание ячейки) уже есть на листе, то фигура выделяется.
Иначе создается новая фигура (например прямоугольник) с таким именем, как содержание ячейки.

Что то не смог найти процедуру поиска фигур.
И фигуры могут иметь одинаковое имя, как с этим быть.

Заранее спасибо.

[EducatedFool]

Что то не смог найти процедуру поиска фигур.

dim sha as shape
On Error Resume Next
set sha = ActiveSheet.shapes(ActiveCell.value)
if sha is nothing then msgbox "Фигура не найдена"

И фигуры могут иметь одинаковое имя, как с этим быть.

а тут сложнее
лучше такого не допускать изначально - а то потом никак не определите, какая нужная, а какая нет

[GAS1979]

Спасибо, работает, дальше уже разберусь

[GAS1979]

Не определяет, что фигуры нет.
Без цикла, все работает.

Dim sha As Shape
On Error Resume Next
For i = 2 To 12

n = Cells(i, 1).Value
Set sha = ActiveSheet.Shapes(n)
x = Cells(Cells(i, 1).Left + 1).Left
y = Cells(i, 1).Top

If sha Is Nothing Then
ActiveSheet.Shapes.AddShape(msoShap eRectangle, x, y, 90, 78).Select
Selection.ShapeRange.Name = n
Selection.Name = n
End If

Next i

[EducatedFool]

это что за код?

x = Cells(Cells(i, 1).Left + 1).Left

так не будет работать...

попробуйте такой вариант:

Sub test()
    Dim sha As Shape, n As String
    On Error Resume Next
    For i = 2 To 12

        n = Cells(i, 1).Value
        Set sha = Nothing: Set sha = ActiveSheet.Shapes(n)
        
        x = Cells(i, 2).Left
        y = Cells(i, 1).Top

        If sha Is Nothing Then
            With ActiveSheet.Shapes.AddShape(msoShapeRectangle, x, y, 90, 78)
                .ShapeRange.Name = n
                .Name = n
            End With
        End If
    Next i
End Sub

[IgorGO]

применительно к Ексель, функция
x = Cells(Cells(i, 1).Left + 1).Left
определена на промежутке для і от 1 до Rows.count
и равно 0 для любых значений і
проверить можно так:

for i = 1 to rows.count
  msgbox  "при i = " & i & "   x = " & Cells(Cells(i, 1).Left + 1).Left
next

ее можно упростить и сразу записать х = 0.

это что за код?

а что задумывал автор, когда писал это знает только он один
VBA не читает мысли, считает то, что написано, а не то, что задумано посчитать

[GAS1979]

x = Cells(Cells(i, 1).Left + 1).Left - эта функция работает
ActiveSheet.Shapes.AddShape(msoShap eRectangle, x, y, 90, 78).Select - тут создаю фигуру справа от ячейки Cells(i, 1)

Set sha = ActiveSheet.Shapes(n) - не отрабатывала эта функция

Теперь этот код работает, поправил только выделенное красным

Dim sha As Shape
On Error Resume Next
For i = 2 To 12

n = Cells(i, 1).Value + "_Об"
Set sha = Nothing: Set sha = ActiveSheet.Shapes(n)
x = Cells(Cells(i, 1).Left + 7).Left
y = Cells(i, 1).Top

If sha Is Nothing Then
ActiveSheet.Shapes.AddShape(msoShap eRectangle, x, y, 90, 78).Select
Selection.ShapeRange.Name = n
Selection.Name = n
End If

Next i

Спасибо

[IgorGO]

x = Cells(Cells(i, 1).Left + 1).Left - эта функция работает

выражение

х = i^2 - i*i

тоже работает и в результате х будет всегда равен 0, как и здесь:

x = Cells(Cells(i, 1).Left + 1).Left

у Вас записано мудренее, но результат-то стабилен = 0.
я предложил упростить это сразу до

х = 0

[GAS1979]

Вы не правы, выдает значение при i=2: x=318; y=15.75
При i=3: x=318; y=30.75
...

Все то, что и надо

[GAS1979]

С этим все разобрался. Создает недостающие фигуры.
Теперь еще, можно ли как то вывести весь список фигур на листе. Мне надо найти лишние фигуры.