Reloj fijo

[XYON126]

Hola Erbuson!

Referente a lo del tamaño del codigo, a menos que el Firefox o algo me lo limite ahora pues antes no me pasaba solo me admite 36 lineas y utilizo el HIGHLIGHT= vbScript aunque ahora lo posteo sin esto, he realizado unos cambios como comentas pero me da error "13" en esta linea y no se porque pues todos son Date o asi creo .:

Código vb:

'Control horario Londres
Label10 = CloseOpen(CDate(Label1.Caption))
 

el codigo con el motor (No se si lo he hecho bien) es este ahora, ¿Podrias comprobarlo?

Muchas gracias

Un saludo

Option Explicit

Dim Londres As Date
Dim Nueva_York As Date
Dim Tokyo As Date
Dim Sidney As Date
Dim Madrid As Date
Dim Francfort As Date
Dim Zurich As Date
Dim Wellington As Date
Dim Toronto As Date
Dim Horario As Date
Dim dia As String

Dim DifLondres As Date
Dim DifNueva_York As Date
Dim DifTokyo As Date
Dim DifSidney As Date
Dim DifWellington As Date
Dim DifToronto As Date


'Funcion para cambiar el color del texto
'################################################# ##########
Private Sub AjustaColor(Letrero As Label)
' Función para unificar y simplificar
If Letrero.Caption = "ABIERTA" Then
Letrero.ForeColor = vbGreen
ElseIf Letrero.Caption = "CERRADA" Then
Letrero.ForeColor = vbRed
Else
Letrero.ForeColor = vbBlack
End If
End Sub

'Funcion para activar el color del texto
'################################################# ##########
Public Function CloseOpen(HoraActual As Date) As String
If HoraActual > CDate("8:29:59") And HoraActual < CDate("17:29:59") Then
CloseOpen = "ABIERTA"
Else
CloseOpen = "CERRADA"
End If

'--------
If dia = "sábado" Or dia = "domingo" Then CloseOpen = "CERRADA"
'--------

End Function

'Funcion para cambiar el color del texto en cada Label
'################################################# ##########
Private Sub Label10_Change()
AjustaColor Label10
End Sub

Private Sub Label11_Change()
AjustaColor Label11
End Sub

Private Sub Label12_Change()
AjustaColor Label12
End Sub

Private Sub Label13_Change()
AjustaColor Label13
End Sub

Private Sub Label14_Change()
AjustaColor Label14
End Sub

Private Sub Label15_Change()
AjustaColor Label15
End Sub

Private Sub Label16_Change()
AjustaColor Label16
End Sub

Private Sub Label17_Change()
AjustaColor Label17
End Sub

Private Sub Label18_Change()
AjustaColor Label18
End Sub


'################################################# ##########
Private Sub HoraActual()

Dim Ahora As Date
Ahora = Now
Label1 = Format(DateAdd("h", -1, Ahora), "ddd hh:mm") 'Londres
Label2 = Format(DateAdd("h", -6, Ahora), "ddd hh:mm") 'NuevaYork
Label3 = Format(DateAdd("h", 7, Ahora), "ddd hh:mm") 'Tokyo
Label4 = Format(DateAdd("h", 8, Ahora), "ddd hh:mm") 'Sidney
Label5 = Format(DateAdd("h", 0, Ahora), "ddd hh:mm") 'Madrid
Label6 = Format(DateAdd("h", 0, Ahora), "ddd hh:mm") 'Francfort
Label7 = Format(DateAdd("h", 0, Ahora), "ddd hh:mm") 'Zurich
Label8 = Format(DateAdd("h", 10, Ahora), "ddd hh:mm") 'Wellington
Label9 = Format(DateAdd("h", -6, Ahora), "ddd hh:mm") 'Toronto

'Control horario Londres
Label10 = CloseOpen(CDate(Label1.Caption))

'Control horario New York
Label11 = CloseOpen(CDate(Label2.Caption))

'Control horario Tokyo
Label12 = CloseOpen(CDate(Label3.Caption))

'Control horario Sidney
Label13 = CloseOpen(CDate(Label4.Caption))

'Control horario Madrid
Label14 = CloseOpen(CDate(Label5.Caption))

'Control horario Francfort
Label15 = CloseOpen(CDate(Label6.Caption))

'Control horario Zürich

Label16 = CloseOpen(CDate(Label7.Caption))

'Control horario Wellington
Label17 = CloseOpen(CDate(Label8.Caption))

'Control horario Toronto
Label18 = CloseOpen(CDate(Label9.Caption))
End Sub

'################################################# ##########
Private Sub Timer1_Timer()
HoraActual
End Sub

'################################################# ##########
Private Sub Form_Load()

HoraActual
Timer1.Interval = 1000
Timer1.Enabled = True

End Sub