Reloj fijo

XYON126 · #1 (**permalink**) 16/07/2010, 10:28

Hola compañeros!

Tengo un problemilla, he realizado un reloj con horarios de varias ciudades y tengo el problema que el reloj se ejecuta pero se queda la hora fija, por otro lado le mando ejecutar dependiendo de que hora sea unos cambios de color y texto y me lo realiza pero no siempre, he realizado varios relojes y jamas me han dado problemas y ahora o estoy muy espeso y ciego pues lo habre mirado tantas veces que no veo los errores. ¿Podriasis echarme una manita?

Un saludo

Aqui os posteo el codigo .:

Código vb:

Ver originalOption 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 Label10_Change()
  If Label10.Caption = "ABIERTA" Then
    Label10.ForeColor = vbGreen
  ElseIf Label10.Caption = "CERRADA" Then
    Label10.ForeColor = vbRed
  Else
    Label10.ForeColor = vbBlack
  End If
End Sub

-rommel_ · #2 (**permalink**) 19/07/2010, 09:44

perdon amigo, el "Label" en que momento cambia???... ese procedimiento si no lo entiendoo... haces que cambie de valor el label???
explicanos en que consiste tu Change del Label

XYON126 · #3 (**permalink**) 19/07/2010, 12:23

Cita:

Iniciado por -rommel_

perdon amigo, el "Label" en que momento cambia???... ese procedimiento si no lo entiendoo... haces que cambie de valor el label???
explicanos en que consiste tu Change del Label

Hola rommel!

Cierto, acabo de ver que el codigo esta incompleto aqui lo posteo de nuevo .:

Código vb:

Ver original'Funcion para cambiar el color del texto
'####################################################
Private Sub Label11_Change()
  If Label11.Caption = "ABIERTA" Then
    Label11.ForeColor = vbGreen
  ElseIf Label11.Caption = "CERRADA" Then
    Label11.ForeColor = vbRed
  Else
    Label11.ForeColor = vbBlack
  End If
End Sub
'Funcion para cambiar el color del texto
'####################################################
Private Sub Label12_Change()
  If Label12.Caption = "ABIERTA" Then
    Label12.ForeColor = vbGreen
  ElseIf Label12.Caption = "CERRADA" Then
    Label12.ForeColor = vbRed
  Else
    Label12.ForeColor = vbBlack
  End If
End Sub
'Funcion para cambiar el color del texto
'####################################################
Private Sub Label13_Change()
  If Label13.Caption = "ABIERTA" Then
    Label13.ForeColor = vbGreen
  ElseIf Label13.Caption = "CERRADA" Then
    Label13.ForeColor = vbRed
  Else
    Label13.ForeColor = vbBlack
  End If
End Sub

XYON126 · #4 (**permalink**) 19/07/2010, 12:28

Veo que se corta el codigo aqui posteo el resto .:

Código vb:

Ver original'Funcion para cambiar el color del texto
'###########################################################
Private Sub Label14_Change()
  If Label14.Caption = "ABIERTA" Then
    Label14.ForeColor = vbGreen
  ElseIf Label14.Caption = "CERRADA" Then
    Label14.ForeColor = vbRed
  Else
    Label14.ForeColor = vbBlack
  End If
End Sub
'Funcion para cambiar el color del texto
'###########################################################
Private Sub Label15_Change()
  If Label15.Caption = "ABIERTA" Then
    Label15.ForeColor = vbGreen
  ElseIf Label15.Caption = "CERRADA" Then
    Label15.ForeColor = vbRed
  Else
    Label15.ForeColor = vbBlack
  End If
End Sub
'Funcion para cambiar el color del texto
'###########################################################
Private Sub Label16_Change()
  If Label16.Caption = "ABIERTA" Then
    Label16.ForeColor = vbGreen
  ElseIf Label16.Caption = "CERRADA" Then
    Label16.ForeColor = vbRed
  Else
    Label16.ForeColor = vbBlack
  End If
End Sub

XYON126 · #5 (**permalink**) 19/07/2010, 12:29

y mas codigo .:

Código vb:

Ver original'Funcion para cambiar el color del texto
'###########################################################
Private Sub Label17_Change()
  If Label17.Caption = "ABIERTA" Then
    Label17.ForeColor = vbGreen
  ElseIf Label17.Caption = "CERRADA" Then
    Label17.ForeColor = vbRed
  Else
    Label17.ForeColor = vbBlack
  End If
End Sub
'Funcion para cambiar el color del texto
'###########################################################
Private Sub Label18_Change()
  If Label18.Caption = "ABIERTA" Then
    Label18.ForeColor = vbGreen
  ElseIf Label18.Caption = "CERRADA" Then
    Label18.ForeColor = vbRed
  Else
    Label18.ForeColor = vbBlack
  End If
End Sub
 
Private Sub Form_Load()
 
'Diferencia horaria en menos
 
DifLondres = "1:00"
DifNueva_York = "6:00"
DifToronto = "6:00"

XYON126 · #6 (**permalink**) 19/07/2010, 12:31

y esto creo es lo ultimo.

Código vb:

Ver original'Diferencia horaria en más
 
DifTokyo = "7:00"
DifSidney = "8:00"
DifWellington = "10:00"
 
Horario = Format(Time, "hh:mm")
dia = Format(Date, "dddd")
 
Londres = Horario - DifLondres
Nueva_York = Horario - DifNueva_York
Tokyo = Horario + DifTokyo
Sidney = Horario + DifSidney
Madrid = Horario
Francfort = Horario
Zurich = Horario
Wellington = Horario + DifWellington
Toronto = Horario - DifToronto
 
 
Label1.Caption = Format(Londres, "hh:mm")
Label2.Caption = Format(Nueva_York, "hh:mm")
Label3.Caption = Format(Tokyo, "hh:mm")
Label4.Caption = Format(Sidney, "hh:mm")
Label5.Caption = Format(Madrid, "hh:mm")
Label6.Caption = Format(Francfort, "hh:mm")
Label7.Caption = Format(Zurich, "hh:mm")
Label8.Caption = Format(Wellington, "hh:mm")
Label9.Caption = Format(Toronto, "hh:mm")

XYON126 · #7 (**permalink**) 19/07/2010, 12:32

pues no aún queda esto .:

Código vb:

Ver original'Control horario Londres
If Label1 >= "17:30" Then
Label10.Caption = "CERRADA"
ElseIf Label1 <= "8:30" Then
Label10.Caption = "CERRADA"
Else
Label10.Caption = "ABIERTA"
End If
 
'Control horario New York
If Label2 <= "17:30" Then
Label11.Caption = "ABIERTA"
ElseIf Label2 >= "8:30" Then
Label11.Caption = "ABIERTA"
ElseIf dia = "sabado" Then
Label11.Caption = "CERRADA"
ElseIf dia = "domingo" Then
Label11.Caption = "CERRADA"
Else
Label11.Caption = "CERRADA"
End If
 
'Control horario Tokyo
If Label3 >= "17:30" Then
Label12.Caption = "CERRADA"
ElseIf Label3 <= "8:30" Then
Label12.Caption = "CERRADA"
Else
Label12.Caption = "ABIERTA"
End If

XYON126 · #8 (**permalink**) 19/07/2010, 12:33

esto.:

Código vb:

Ver original'Control horario Sidney
If Label4 >= "17:30" Then
Label13.Caption = "CERRADA"
ElseIf Label4 <= "8:30" Then
Label13.Caption = "CERRADA"
Else
Label13.Caption = "ABIERTA"
End If
 
'Control horario Madrid
If Label5 >= "17:30" Then
Label14.Caption = "CERRADA"
ElseIf Label5 <= "8:30" Then
Label14.Caption = "CERRADA"
Else
Label14.Caption = "ABIERTA"
End If
 
'Control horario Francfort
If Label6 >= "17:30" Then
Label15.Caption = "CERRADA"
Else
Label15.Caption = "ABIERTA"
End If
 
'Control horario Zürich
If Label7 >= "17:30" Then
Label16.Caption = "CERRADA"
Else
Label16.Caption = "ABIERTA"
End If

angcam · #9 (**permalink**) 19/07/2010, 12:40

El reloj solo se actualiza una vez al hecer el evento load.
Falta codificar una funcion en bucle que actualice todos los labels igualmente despues de cambiar el valor de la hora base y todas las diferencias y de ahi todo el resto

Saludos

XYON126 · #10 (**permalink**) 19/07/2010, 12:45

y finalmente esto .:

Código vb:

Ver original'Control horario Wellington
If Label8 <= "17:30" Then
Label17.Caption = "CERRADA"
ElseIf Label8 >= "8:30" Then
Label17.Caption = "CERRADA"
Else
Label17.Caption = "ABIERTA"
End If
 
'Control horario Toronto
If Label9 >= "17:30" Then
Label18.Caption = "CERRADA"
ElseIf Label8 >= "8:30" Then
Label18.Caption = "CERRADA"
Else
Label18.Caption = "ABIERTA"
End If
 
 
End Sub

XYON126 · #11 (**permalink**) 19/07/2010, 12:49

Cita:

Iniciado por angcam

El reloj solo se actualiza una vez al hecer el evento load.
Falta codificar una funcion en bucle que actualice todos los labels igualmente despues de cambiar el valor de la hora base y todas las diferencias y de ahi todo el resto

Saludos

Hola angcam!

Ya se que hay muchas lotes iguales, suponiendo que solo esta Madrid y Wellington el bucle que comentas ¿como lo realizarias? pues posiblemente al utilizar solo un reloj no me he encontrado con el problema y ahora voy perdido.

un saludo

erbuson · #12 (**permalink**) 19/07/2010, 14:22

Hola compañero:

Creo que una manera de simplificar loas ajustes de Color, sería por ejemplo creando una función que recibe un Label y en función de su Caption ajusta el Color:

Código vb:

Ver originalPrivate 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
 
 
Private Sub Label17_Change()
  AjustaColor label17
End Sub
 
Private Sub Label18_Change()
  AjustaColor label18
End Sub

De este modo, te evitas muchas sentencias repetidas y si por casualidad decidieras algun cambio adicional, como por ejemplo poner en Negrita, Itálica, etc, con efectuar un ligero cambio en la Rutina AjustaColor, cambias todo el programa.

Saludos

-rommel_ · #13 (**permalink**) 19/07/2010, 14:30

asi es... eso queria recomendarte... pero aun no entiendo que necesitas de todo ese codigo que pusiste inicialmente... en que momento no te funciona el codigo???

XYON126 · #14 (**permalink**) 20/07/2010, 12:25

hola erbuson, rommel!

Ante todo gracias por la función erbuson, de echo yo habia intentado algo parecido cuando me pasastes lo del color en el otro post y lo que no sabia (estaba muy espeso) como ejecutarla función.

Rommel, referente a tu consulta el tema es el siguiente, este reloj me da la hora en todos esos paises y si la hora en ese pais esta entre las 8:30 y las 17:30 pero no antes de las 8:30 ni despues de las 17:30 me sale el letrero ABIERTA por lo contrario visualiza CERRADA que es el horario activo de la BOLSA, el problema esta en:

El reloj no se actualiza, se me queda con la hora de inicio.
El reloj no actualiza siempre a su horario real, aleatoriamente y no se porque si es OK, con lo que me sale ABIERTA a las 7:30 o a las 18:30 cuando deberia ser CERRADA o lo contrario a las 13:00 por ejemplo.
Y en el reloj de New York ademas tambien pregunta si es Sabado o domingo para enseñar CERRADA pero pasa lo mismo, me da ABIERTA y a veces CERRADA.

Como ves estos son los problemas que tengo he estado un mes y medio sin hacer VB y ahora me pierdo hasta que me ponga al dia dentro de mi desconocimiento de este.

Un saludo

erbuson · #15 (**permalink**) 20/07/2010, 12:34

Hola, si por lo que entiendo el condicionante es para todos el mismo, se me ocurre que deberías hacer también un función reutilizable a la que mandes la hora y te devuelva el título de ABIERTA o CERRADA

Algo así como, (voy pensando a medida que escribo y solo es para dar una idea, se aceptan sugerencias)

Suponiendo que Label18 es HoraToronto, se podria tener una funcion tal que así:

Function CloseOpen(HoraActual As String) As String
If HoraActual >= "08:30" And HoraActual <= "17:30" Then
CloseOpen = "ABIERTA"
Else
CloseOpen = "CERRADA"
End If
End Function

A la que podrías llamar Label18.Caption = CloseOpen(HoraToronto)

Es una idea para simplificar el código.

Saludos

DE TODOS MODOS NO ME GUSTA EL TIPO DE DATOS STRING YA QUE SEGURISIMO QUE HAY ERRORES DE COMPARACION YA QUE EN STRING "17:30" ES MENOR QUE "8:30" PERO MAYOR QUE "08:30" SERIA MEJOR EMPLEAR TIPOS DATE

erbuson · #16 (**permalink**) 20/07/2010, 12:50

Con esta funcion, (me pico la curiosidad) te puede valer, la he testeado y funciona:

Código vb:

Ver originalPublic 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
End Function

Puedes utilizarla así para Wellington Label17 = CloseOpen(cdate(Label8.Caption))

Saludos

XYON126 · #17 (**permalink**) 21/07/2010, 13:30

Hola erbuson!

Lo he probado y funciona como dices, el tema del refresco del reloj supongo que debere hacer un bucle pero donde, otra cosa ¿Cuantas veces es posible poner la orden "and" en un If? pues quiero activar tambien si es sabado y domingo para cerrar o dejar abierta.

Un saludo y 1000 gracias

erbuson · #18 (**permalink**) 21/07/2010, 14:21

Hola:

Puedes poner los And que quieras siempre que la comparación tenga un sentido, sin embargo en este caso se me ocurre que lo mas simple que puedes hacer es algo así ajustando debidamente las variables.

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 = "Sabado" Or Dia = "Domingo" Then CloseOpen = "CERRADA"
'--------
End Function

Ya que de este modo independientemente de que por la Hora este abierta, si es Sabado o Domingo siempre la dara CERRADA

Saludos

XYON126 · #19 (**permalink**) 24/07/2010, 01:23

Hola erbuson!

Gracias por el codigo, ahora esa parte me funciona perfectamente aunque despues de un arreglillo tonto, este :

Tu codigo:

If Dia = "Sabado" Or Dia = "Domingo" Then CloseOpen = "CERRADA"

con arreglillo:

If Dia = "sábado" Or Dia = "domingo" Then CloseOpen = "CERRADA"

por esa chorradita que supongo tu ya lo sabias me fallaba lo del finde, ahora solo me falta lo del refresco del reloj púes como principal problema es que se queda con la hora fija y no refresca, ¿Donde esta el error?

Un saludo

erbuson · #20 (**permalink**) 24/07/2010, 01:42

Hola:

¿ Como lo haces para actualizar los labels ? Imagino que tienes un timer y que lo tienes en enabled ya que no se me ocurre otra posibilidad.

El AutoRedraw del formulario, un DoEvents, ...

Pega la parte que usas para actualizarlo y lo pruebo.

Saludos

XYON126 · #21 (**permalink**) 24/07/2010, 12:14

Hola erbuson!

Aqui posteo todo el codigo corregido, posiblemente sean varios post.

Un saludote y muchas gracias.

Código vb:

Ver originalOption 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

Efectivamente solo puedo postear 36 lineas por post, este es el primero.

XYON126 · #22 (**permalink**) 24/07/2010, 12:15

segundo..

Código vb:

Ver original'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
'###########################################################
Private Sub Label10_Change()
  AjustaColor Label10
End Sub

XYON126 · #23 (**permalink**) 24/07/2010, 12:19

Tercero

Código vb:

Ver original'Funcion para cambiar el color del texto
 
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

XYON126 · #24 (**permalink**) 24/07/2010, 12:21

Cuarto..

Código vb:

Ver originalPrivate Sub Form_Load()
 
'Diferencia horaria en menos
DifLondres = "1:00"
DifNueva_York = "6:00"
DifToronto = "6:00"
 
'Diferencia horaria en más
DifTokyo = "7:00"
DifSidney = "8:00"
DifWellington = "10:00"
 
Horario = Format(Time, "hh:mm")
dia = Format(Date, "dddd")
 
Londres = Horario - DifLondres
Nueva_York = Horario - DifNueva_York
Tokyo = Horario + DifTokyo
Sidney = Horario + DifSidney
Madrid = Horario
Francfort = Horario
Zurich = Horario
Wellington = Horario + DifWellington
Toronto = Horario - DifToronto
 
Label1.Caption = Format(Londres, "hh:mm")
Label2.Caption = Format(Nueva_York, "hh:mm")
Label3.Caption = Format(Tokyo, "hh:mm")
Label4.Caption = Format(Sidney, "hh:mm")
Label5.Caption = Format(Madrid, "hh:mm")
Label6.Caption = Format(Francfort, "hh:mm")
Label7.Caption = Format(Zurich, "hh:mm")
Label8.Caption = Format(Wellington, "hh:mm")
Label9.Caption = Format(Toronto, "hh:mm")

erbuson · #25 (**permalink**) 24/07/2010, 15:42

Hola Xyon:

Si este es todo el código, evidentemente el problema esta en que para cambiar el valor de los labels, SOLO lo hace en el Form_Load y como bien sabes esto solamente ocurre en cuanto se carga el formulario.

Te hace falta el MOTOR que las hace cambiar.

Personalmente pienso que deberías crear una rutina que te cambie los labels, por ejemplo cambiando el nombre de Form_Load por HoraActual, ya que el código que veo incluido en el mismo es el que necesitas, despues cambias el siguiente código:

Deberás incluir un Timer con el intervalo que desees ajustar, cada minuto, cada medio minuto, etc, tu mismo y supongamos que le llamas TimerHora

Private Sub Form_Load()
HoraActual
TimerHora.Enabled = True
End

Después en el en el evento

Private Sub TimerHora_Timer()
HoraActual
End Sub

De este modo debería cambiarte cuando tu decidas los labels de Hora.

Una duda, que se me ocurre así, sin analizar demasiado es el hecho de que por la diferencia horaria, tal vez pueda darse, ya te digo que no me he entretenido en comprobarlo que sea el mismo Dia en todas los poblaciones.

De ser así la comparación Sabado/Domingo deberías condicionarla en base a cada hora local.

Saludos

erbuson · #26 (**permalink**) 24/07/2010, 16:09

Hola de nuevo Xyon:

Efectivamente, acabo de comprobar lo que te comentaba del horario:

¿ Que tal te parece esta idea ?

Código VB:

Ver originalPrivate Sub Form_Load()
  HoraActual
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
End Sub

Saludos

Por cierto, acabo de probar lo de insertar código en el foro y a mi personalmente no me aparece ninguna limitación de lineas.

XYON126 · #27 (**permalink**) 25/07/2010, 02:22

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:

Ver original'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

erbuson · #28 (**permalink**) 25/07/2010, 04:32

Hola, después te lo compruebo, de todos modos el error que te da es ur error lógico ya que yo lo único que pretendía demostrarte visualizando el día es que pueden cambiar y cuando en uno es viernes, ser sábado en el otro.

Al hacer el cdate de "sab 15:00" por ejemplo, da un error porque esto no es una fecha ya que hemos utilizado el format para ver lo que a nosotros nos interesa.

Debe hacerse de otra manera, con algun truquillo por ejemplo hacer con el right$ y el left$ separar el día de la hora o algo por el estilo.

Ya te digo, un poco mas tarde lo reviso y te comento lo que yo haría.

Saludos

erbuson · #29 (**permalink**) 25/07/2010, 06:00

Hola Xyon:

He corregido parcialmente tu código . Cuando se van a utilizar muchos Labels o controles iguales con una función mas o menos parecida es muchos mas simple y facil utilizar arrays de Controles.

En este caso he creado lo necesario, tu puedes crear el resto para la imagen del programa.

Un Array llamado QueHora con los indices QueHora(0) a QueHora(8)
Un Array llamado ComoEsta con los indices ComoEsta(0) a ComoEsta(8)

Se corresponden de o a 8 con las Poblaciones que utilizas.

Este sería el código del programa

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

La siguiente ha sido modificada para evitar el error y recibe el Label que contiene ddd hh:mm:ss por lo que efectúa la separación y conversión necesaria.

'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

La siguiente rutina es el Change del Label, con la ventaja de que SOLO necesitas una por muchos Labels que tengas ya que el Index determina que Label ha cambiado.

'Funcion para cambiar el color del texto en cada Label
'################################################# ##########
Private Sub ComoEsta_Change(Index As Integer)
AjustaColor ComoEsta(Index)
End Sub

Modificada la siguiente para llamar a una nueva PonerHora, que al tenerlo de este modo tiene la ventaja de que puede muy facilmente cambiar el formato de visualización ya que debes hacerlo sólo en un sitio.

'################################################# ##########
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

La siguiente de poner hora, que como ves se encarga ella misma de llamar a la que modificará el texto de ABIERTA/CERRADA al tener los indices es muy facil ya que QueHora(Indice) se corresponde con ComoEsta(Indice)

'################################################# ##########
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", -1, 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

Bueno, espero no haberte confundido, la única intención como muy bien sabes por otros contactos que hemos tenido es que simplifiques tus futuaras aplicaciones.

Saludos

XYON126 · #30 (**permalink**) 25/07/2010, 09:43

Hola erbuson!

Como bien dices "esperas no confundirme" desde luego confundirme no pero ahora me toca digerirlo bien y comprender lo que has posteado. Las Arrays que has creado son Date o Integer pues lo he probado y me da en este trozo de codigo el error "error de copilacion" El tipo de argumento de ByRef no coincide. y me apunta a esta parte de codigo.:

Código vb:

Ver original'################################################# ##########
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", -1, LaHora), "ddd hh:mm:ss")
' Después, la misma rutina, efectua el cambio de Abierta/Cerrada
ComoEsta(Indice) = CloseOpen(QueHora(Indice))
End Sub

por otro lado veo que en esta linea de codigo recortas el nombre ¿Porque? lo pregunto por desconocimiento.

Código vb:

Ver originalIf Dia = "sáb" Or Dia = "dom" Then CloseOpen = "CERRADA"

Un saludo