Semaforo en EXcel

[abrahamvj]

aun estaba en hora de almuerzo, asi que aproveche y te hic algo. Pegalo en el modulo de la hoja:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim intvalor%
If Target.Address = "$A$1" Then
intvalor% = Target.Value
Select Case intvalor%
Case 1 To 6
ActiveSheet.Shapes("Elipse 4").Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Case 6.1 To 8.5
ActiveSheet.Shapes("Elipse 4").Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 13
Case 8.6 To 10
ActiveSheet.Shapes("Elipse 4").Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 17
Case Else
ActiveSheet.Shapes("Elipse 4").Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 1
End Select
End If
End Sub

Abraham