HORA ACTUAL EN USERFORM

hola, Luis !

He visto en alguna ocasión el código para insertar dentro de un Userform la hora actual del sistema
, y que la misma se actualice de tal manera que se muestre como un Reloj.
Esto es muy util y funciona a la perfeccion, pero yo quisiera que el usuario no pueda registrar una accion
en una hora o fecha previa a la real (por ejemplo cambiando la hora del sistema)
por eso me gustaria que este reloj se actualice a traves de un horario tomado de internet o algo por el estilo...

si el "punto debil" NO esta en la programacion o alternativas posibles de programar
sino en la falta de personal "honesto"... de fiar... responsable de sus acciones, etc.
prueba alternativas para prevenir manipulaciones a la hora del sistema (reiniciando con horas "convenientes")
-> visitando sitios como los que encuentras aqui: http://search.live.com/results.aspx...-SearchBox
(por tus macros podrias depositar una hora "estandar" o quiza, la que corresponda a la localidad del operador/usuario) -???-

saludos,
hector.

Muchas Gracias por tu valiosa ayuda como siempre Héctor.. he visitado
el link que me recomendaste y me direccioné a http://www.timeanddate.com/worldclock/full.html
El problema es que no puedo realizar la siguiente parte de tu mensaje:
"(por tus macros podrias depositar una hora "estandar" o quiza, la que
corresponda a la localidad del operador/usuario)" porq no se cómo
hacerlo =(

Cabe anotar que mi código es el siguiente:

//En el Formulario:
Private Sub UserForm_Activate()

Call SetTime

frmReloj.txtFecha.Value = Format$(Now, "hh:mm:ss")

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As
Integer)

Call Disable
'EndProcess

End Sub

//En un módulo normal:

Option Explicit

Public SchedRecalc As Date

Sub SetTime()
SchedRecalc = Now + TimeValue("00:00:01")
Application.OnTime SchedRecalc, "Recalc"
End Sub

Sub Recalc()
frmReloj.txtFecha.Value = Format$(Now, "hh:mm:ss")
Call SetTime
End Sub

Sub Disable()
On Error Resume Next
Application.OnTime EarliestTime:=SchedRecalc, Procedure:="Recalc",
Schedule:=False
End Sub

Luego lo que hago es que el usuario escriba su identificación en un
textbox y al presionar un botón se registre la hora y fecha de la
acción.

Mi pregunta es ahora cómo depositar la Hora que corresponda a la
localidad del usuario en txtFecha, de tal manera que no use la función
Now que hasta donde se recoge únicamente la hora del sistema.

Muchísimas Gracias nuevamente!

hola, Luis !

... he visitado el link que me recomendaste y me direccione a http://www.timeanddate.com/worldclock/full.html
El problema es que no puedo realizar la siguiente parte de tu mensaje:
"(por tus macros podrias depositar una hora "estandar" o quiza, la que corresponda a la localidad del operador/usuario)" ...
Cabe anotar que mi codigo es el siguiente: (... ... ...)
Luego lo que hago es que el usuario escriba su identificacion en un textbox
y al presionar un boton se registre la hora y fecha de la accion.
Mi pregunta es ahora cómo depositar la Hora que corresponda a la localidad del usuario en txtFecha
de tal manera que no use la funcion Now que hasta donde se recoge unicamente la hora del sistema...

1) es probable que puedas evitar el uso de procedimientos recursivos (OnTime) para (solo) refrescar la hora en un control de textos
si en lugar de controles de texto (etiquetas o cuadros) utilizas un control "StatusBar" (toma la hora del sistema sin codigos extra)

a) agrega un control (statusbar) al cuadro de controles del editor de vba (y obviamente agregas un control a tu formulario)
lo encuentras por orden alfabetico (mas controles...) +/- en: -> Microsoft StatusBar Control, version x.0 (SPx)

b) en el modulo de codigo de tu fornulario agregas el siguiente procedimiento (ojo con el nombre real del control)

Private Sub UserForm_Initialize()
Me.StatusBar1.Panels(1).Style = sbrTime
End Sub

2) no se que tanto pudiera resultar mas efectivo "buscar" en paginas globales la hora correspondiente a la configuracion regional de x_equipo
o buscar mejor una sincronizacion de la fecha/hora del sistema, lo que evitaria "manipulaciones" por parte de los usuarios (?)

para la segunda alternativa, prueba visitando (y adaptando para VBA) los siguientes ejemplos (para VB):

Synchronizing Date and Time to a Remote Server
http://vbnet.mvps.org/code/network/...odsync.htm

NetRemoteTOD: Get Time of Day Info for Local or Remote Machines
http://vbnet.mvps.org/code/network/...otetod.htm

SetSystemTime: SNTP Time Server Synchronization using Winsock
http://vbnet.mvps.org/code/network/...nctime.htm

WM_TIMECHANGE: Detect System Changes to the Date/Time
http://vbnet.mvps.org/code/subclass/datetime.htm

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

__ el codigo expuesto __
//En el Formulario:
Private Sub UserForm_Activate()
Call SetTime
frmReloj.txtFecha.Value = Format$(Now, "hh:mm:ss")
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Call Disable
'EndProcess
End Sub

//En un modulo normal:

Option Explicit
Public SchedRecalc As Date

Sub SetTime()
SchedRecalc = Now + TimeValue("00:00:01")
Application.OnTime SchedRecalc, "Recalc"
End Sub

Sub Recalc()
frmReloj.txtFecha.Value = Format$(Now, "hh:mm:ss")
Call SetTime
End Sub

Sub Disable()
On Error Resume Next
Application.OnTime EarliestTime:=SchedRecalc, Procedure:="Recalc",
Schedule:=False
End Sub

Muchas gracias por tu ayuda Héctor! Te cuento que revisé el primer
link que me sugeriste puesto que en el se captura la fecha y hora de
un servidor remoto dentro de un textbox... El problema es que cuando
ejecuto el programa en este text me aparece 01/01/1970 nada más y no
se qué está ocurriendo =s

A continuación expongo las 2 funciones que considero son las más
importantes, cabe recalcar que en Text2 es donde se captura la fecha y
hora del servidor remoto

Private Function GetRemoteTOD(ByVal sServer As String) As
TIME_OF_DAY_INFO

Dim bServer() As Byte
Dim tod As TIME_OF_DAY_INFO
Dim bufptr As Long

'A null passed as sServer retrieves
'the date for the local machine. If
'sServer is null, no slashes are added.
If sServer <> vbNullChar Then

'If a server name was specified,
'assure it has leading double slashes
If Left$(sServer, 2) <> "\\" Then
bServer = "\\" & sServer & vbNullChar
Else
bServer = sServer & vbNullChar
End If

Else

'null or empty string was passed
bServer = sServer & vbNullChar

End If


'get the time of day (TOD) from the specified server
If NetRemoteTOD(bServer(0), bufptr) = NERR_SUCCESS Then

'copy the buffer into a
'TIME_OF_DAY_INFO structure
CopyMemory tod, ByVal bufptr, LenB(tod)

End If

Call NetApiBufferFree(bufptr)

'return the TIME_OF_DAY_INFO structure
GetRemoteTOD = tod

End Function

Private Function SynchronizeTOD(ByVal sRemoteServer As String) As Date

Dim newdate As Date
Dim sys_sync As SYSTEMTIME
Dim server_date As TIME_OF_DAY_INFO
Dim local_date As TIME_OF_DAY_INFO

'Obtain a TIME_OF_DAY_INFO structure from the
'remote machine with which to synchronize to.
server_date = GetRemoteTOD(sRemoteServer)

'case returned values into a SYSTEMTIME structure
'and pass to the SetSystemTime api
With sys_sync
.wHour = server_date.tod_hours
.wMinute = server_date.tod_mins
.wSecond = server_date.tod_secs
.wDay = server_date.tod_day
.wMonth = server_date.tod_month
.wYear = server_date.tod_year
End With

If SetSystemTime(sys_sync) <> 0 Then

'sync was successful, so return Now
SynchronizeTOD = Now

End If


' for demo only
'The first shows calculating the
'date using the tod_elapsedt member.
'tod_elapsedt is a value that contains
'the number of seconds since
'00:00:00, January 1, 1970, GMT.
'Since tod_elapsedt is based on GMT (UTC),
'the next date applies the tod_timezone
'offset to adjust the date to the local time.
newdate = DateAdd("s", server_date.tod_elapsedt, #1/1/1970#)
newdate = DateAdd("n", -server_date.tod_timezone, newdate)
Text2.Text = newdate
'--

End Function

Muchas Gracias!

pd: la propuesta que hiciste del status bar me parece grandiosa!!
Gracias =)

hola, Luis !

... revise el primer link que me sugeriste puesto que en el se captura la fecha y hora de un servidor remoto dentro de un textbox
El problema es que cuando ejecuto el programa en este text me aparece 01/01/1970 nada mas y no se que esta ocurriendo =s ...

solo faltaria que comentes la direccion del servidor que le pasas a las funciones (?)

saludos,
hector.

__ OP __
Private Function GetRemoteTOD(ByVal sServer As String) As TIME_OF_DAY_INFO

Dim bServer() As Byte
Dim tod As TIME_OF_DAY_INFO
Dim bufptr As Long

'A null passed as sServer retrieves
'the date for the local machine. If
'sServer is null, no slashes are added.
If sServer <> vbNullChar Then

'If a server name was specified,
'assure it has leading double slashes
If Left$(sServer, 2) <> "\\" Then
bServer = "\\" & sServer & vbNullChar
Else
bServer = sServer & vbNullChar
End If

Else

'null or empty string was passed
bServer = sServer & vbNullChar

End If


'get the time of day (TOD) from the specified server
If NetRemoteTOD(bServer(0), bufptr) = NERR_SUCCESS Then

'copy the buffer into a
'TIME_OF_DAY_INFO structure
CopyMemory tod, ByVal bufptr, LenB(tod)

End If

Call NetApiBufferFree(bufptr)

'return the TIME_OF_DAY_INFO structure
GetRemoteTOD = tod

End Function

Private Function SynchronizeTOD(ByVal sRemoteServer As String) As Date

Dim newdate As Date
Dim sys_sync As SYSTEMTIME
Dim server_date As TIME_OF_DAY_INFO
Dim local_date As TIME_OF_DAY_INFO

'Obtain a TIME_OF_DAY_INFO structure from the
'remote machine with which to synchronize to.
server_date = GetRemoteTOD(sRemoteServer)

'case returned values into a SYSTEMTIME structure
'and pass to the SetSystemTime api
With sys_sync
.wHour = server_date.tod_hours
.wMinute = server_date.tod_mins
.wSecond = server_date.tod_secs
.wDay = server_date.tod_day
.wMonth = server_date.tod_month
.wYear = server_date.tod_year
End With

If SetSystemTime(sys_sync) <> 0 Then

'sync was successful, so return Now
SynchronizeTOD = Now

End If


' for demo only
'The first shows calculating the
'date using the tod_elapsedt member.
'tod_elapsedt is a value that contains
'the number of seconds since
'00:00:00, January 1, 1970, GMT.
'Since tod_elapsedt is based on GMT (UTC),
'the next date applies the tod_timezone
'offset to adjust the date to the local time.
newdate = DateAdd("s", server_date.tod_elapsedt, #1/1/1970#)
newdate = DateAdd("n", -server_date.tod_timezone, newdate)
Text2.Text = newdate
'--

End Function

Muchas Gracias!

pd: la propuesta que hiciste del status bar me parece grandiosa!! Gracias =)