Подставление фигуры в ячейку по условию

[Казанский]

Сможет, если кое-что добавить

Sub Скругленныйпрямоугольник3_Щелчок()
Dim r As Range, c As Range, x
  On Error Resume Next
  Set r = Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
  If r Is Nothing Then
    Set r = Cells.SpecialCells(xlCellTypeFormulas, xlNumbers)
  Else
    Set r = Union(r, Cells.SpecialCells(xlCellTypeFormulas, xlNumbers))
  End If
  For Each c In r
    Select Case c.Value
    Case 1: x = "РомбЗел": GoSub 1
    Case 2: x = "РомбКрас": GoSub 1
    End Select
  Next
  Exit Sub

1 With ActiveSheet.Shapes(x).Duplicate
    .Left = c.Left + (c.Width - .Width) / 2
    .Top = c.Top + (c.Height - .Height) / 2
    .Visible = True
  End With
  Return
End Sub