Option Explicit

Sub Pr()
     Dim c As Range, lColor As Long
     For Each c In ActiveSheet.UsedRange
         Select Case c.Value
         Case "@0A@": lColor = vbRed
         Case "@09@": lColor = vbYellow
         Case "@08@": lColor = vbGreen
         Case Else: lColor = 0
         End Select

         If lColor Then
             '''c.Select
             SetShape c, lColor
             'c.ClearContents    ' ПОСЛЕ ПРОВЕРКИ АПОСТРОФ В НАЧАЛЕ СТРОКИ УДАЛИТЬ!
         End If
     Next c

End Sub

Sub SetShape(rng As Range, lColor As Long)
     Const D = 7

     With ActiveSheet.Shapes.AddShape(msoShapeOval, _
                    (rng.Left + rng.Offset(, 1).Left - D) / 2, _
                    (rng.Top + rng.Offset(1).Top - D) / 2, _
                    D, D)    ' _
                    rng.Height / 2, rng.Height / 2)
         .Line.Visible = msoFalse
         .Fill.ForeColor.RGB = lColor
     End With
End Sub

'c.ClearContents    ' ПОСЛЕ ПРОВЕРКИ АПОСТРОФ В НАЧАЛЕ СТРОКИ УДАЛИТЬ!