Cita:
Iniciado por -rommel_ y mejor posteas tu codigo... o subes tu aplicacion para beneficio de todos... siiii
Por mi parte no hay ningun problema aunque podriamos decir mejor el codigo de erbuson, ya que me lo ha corregido, mejorado y eliminar todo error, dejandolo como de un profesional y no de un autodidacta como hobby como soy yo.
Aqui posteo una imagen de como queda ahora con este codigo, las pictures o todo el paquete si alguien lo quiere se lo remito por E-mail.
Un saludote
aunque la version mejorada sera asi mas o menos(esta en proceso)
Bueno aqui el codigo lo de los Label necesarios, etc. con las fotos se ve, espero.
codigo .:
Option Explicit
'Funcion para cambiar el color del texto
'################################################# ##########
Private Sub AjustaColor(Letrero As Label)
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 determinar Abierta/Cerrada
'################################################# ##########
' Ha sido modificada para recibir el Caption del Label que muestra el día y hora
Public Function CloseOpen(LabelHora As Label) As String
Dim Hora As Date, Dia As String
Hora = CDate(Right$(LabelHora.Caption, 8))
Dia = Left$(LabelHora.Caption, 3)
If Hora > CDate("8:29:59") And Hora < CDate("17:29:59") Then
CloseOpen = "ABIERTA"
Else
CloseOpen = "CERRADA"
End If
If Dia = "sáb" Or Dia = "dom" Then CloseOpen = "CERRADA"
End Function
'Funcion para cambiar el color del texto en cada Label
'################################################# ##########
Private Sub ComoEsta_Change(Index As Integer)
AjustaColor ComoEsta(Index)
End Sub
'################################################# ##########
Private Sub HoraActual()
Dim Ahora As Date, Indice As Integer
Ahora = Now
PonerHora 0, Ahora, -1 'Londres
PonerHora 1, Ahora, -6 'NuevaYork
PonerHora 2, Ahora, 7 'Tokyo
PonerHora 3, Ahora, 8 'Sidney
PonerHora 4, Ahora, 0 'Madrid
PonerHora 5, Ahora, 0 'Francfort
PonerHora 6, Ahora, 0 'Zurich
PonerHora 7, Ahora, 10 'Wellington
PonerHora 8, Ahora, -6 'Toronto
End Sub
'################################################# ##########
Private Sub PonerHora(Indice As Integer, LaHora As Date, Diferencia As Integer)
' Pone la Hora en la Etiqueta correspondiente a Indice
QueHora(Indice) = Format(DateAdd("h", Diferencia, LaHora), "ddd hh:mm:ss")
' Después, la misma rutina, efectua el cambio de Abierta/Cerrada
ComoEsta(Indice) = CloseOpen(QueHora(Indice))
End Sub
'################################################# ##########
Private Sub Timer1_Timer()
HoraActual
End Sub
'################################################# ##########
Private Sub Form_Load()
HoraActual
Timer1.Interval = 1000
Timer1.Enabled = True
End Sub