Como hacer dos semáforos (imágenes) en excel, cada semáforo independientes

Buen día, tengo un problema, encontré un ejemplo de un semáforo (una imagen que hace movimiento por medio de macros) que bajo ciertas condiciones cambia de color, el ejemplo lo estoy aplicando para una base que tengo pero necesito que los dos semáforos que requiero sean independientes, he intentado pero no logro como hacer que los dos semáforos sean independientes, si funciona uno, el otro deja de funcionar, no se que este haciendo mal, alguien pudiera ayudarme.

Esta es la macro original, funciona a base de dibujos de excel (elipses) y es la siguiente:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Call ámbar
dd = ActiveSheet.Cells(10, 12).Value
If dd > 0.1688 Then GoTo rojo
If dd < 0.1399 Then GoTo verde
End

rojo:
Call rojo
End

verde:
Call verde
End

Application.ScreenUpdating = True

End Sub

Sub verde()
Hoja1.Shapes("Elipse 26").Visible = False
Hoja1.Shapes("Elipse 27").Visible = False
Hoja1.Shapes("Elipse 28").Visible = True
End Sub
Sub ámbar()
Hoja1.Shapes("Elipse 26").Visible = False
Hoja1.Shapes("Elipse 28").Visible = False
Hoja1.Shapes("Elipse 27").Visible = True
End Sub


Sub rojo()
Hoja1.Shapes("Elipse 27").Visible = False
Hoja1.Shapes("Elipse 28").Visible = False
Hoja1.Shapes("Elipse 26").Visible = True
End Sub

Yo hice mis modificaciones para mi uso y me quedo de la siguiente manera, pero como lo explique anteriormente, si funciona una la de abajo deja de funcionar y no se como hacer que ambas funcionen al mismo tiempo ya que evalúan condiciones distintas.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Call ámbar
Call yellow
If ActiveSheet.Cells(59, 7).Value > 5.9 Then GoTo red
If ActiveSheet.Cells(20, 7).Value > 5.9 Then GoTo rojo
If ActiveSheet.Cells(59, 7).Value <= 5.9 Then GoTo green
If ActiveSheet.Cells(20, 7).Value <= 5.9 Then GoTo verde
End

rojo:
Call rojo
End

red:
Call red
End

verde:
Call verde
End

green:
Call green
End

Application.ScreenUpdating = True
End Sub

Sub verde()
Hoja1.Shapes("Elipse 26").Visible = False
Hoja1.Shapes("Elipse 27").Visible = False
Hoja1.Shapes("Elipse 28").Visible = True
End Sub

Sub ámbar()
Hoja1.Shapes("Elipse 26").Visible = False
Hoja1.Shapes("Elipse 28").Visible = False
Hoja1.Shapes("Elipse 27").Visible = True
End Sub

Sub rojo()
Hoja1.Shapes("Elipse 27").Visible = False
Hoja1.Shapes("Elipse 28").Visible = False
Hoja1.Shapes("Elipse 26").Visible = True
End Sub


Sub green()
Hoja1.Shapes("1 Elipse").Visible = False
Hoja1.Shapes("2 Elipse").Visible = False
Hoja1.Shapes("8 Elipse").Visible = True
End Sub

Sub yellow()
Hoja1.Shapes("1 Elipse").Visible = False
Hoja1.Shapes("8 Elipse").Visible = False
Hoja1.Shapes("2 Elipse").Visible = True
End Sub

Sub red()
Hoja1.Shapes("2 Elipse").Visible = False
Hoja1.Shapes("8 Elipse").Visible = False
Hoja1.Shapes("1 Elipse").Visible = True
End Sub

Espero me puedan ayudar a resolver mi gran problema.

Añade tu respuesta

Haz clic para o