Reloj que no se detiene

Este código
Private Sub cmdCierraApli_Click() 'cierra formulario
' ActiveWorkbook.Save  'Guarda posibles cambios de datos
If MsgBox("¿Estás seguro que quieres cerrar?", vbYesNo) = vbYes Then 'mensage para salir
    Unload Me
    Else
            Call Detener_reloj '"LLamado" a rutina que detiene el OnTime
            End If
    Sheets(1).Select
End Sub
Ya hice casi lo imposible dentro de mis posibilidades (que son muy pocas en esto de programación)
Funciona bien si quito el reloj (Call)
Funciona bien si dejo el Call y quito el If MsgBox y End IF del msgbox y el Else del Call.
Así tal como lo ves funciona PEEEEROOO el reloj no se detiene y es molesto para escribir y programar porque me saca de frente el formulario.
¿Cómo hacer esto mismo pero que me detenga el reloj?
{"lat":10.2686830625024,"lng":-67.5781488418579}

1 respuesta

Respuesta
1
Para intentar ayudarte, ¿podrías ponerme el código de la rutina del reloj? ¿O del que detiene?
Todo el código delreloj
En el modulo
--------------------------------------------
Option Explicit
Sub Tiempo()
'Mediante esta instruccion "llamamos" a "Actualizarreloj" para volver a _
actualzizar el Label con la hora
  Application.OnTime Now + TimeValue("00:00:01"), _
        Procedure:="Actualizarreloj", _
        Schedule:=True
End Sub
Sub Actualizarreloj()
'Coloca la hora en el Label del UserForm
Formulario.LabHora = Time
'"Llama a la rutina que cada 01 segundo "llama" a "Actualizarreloj" para volver a _
actualzizar el Label con la hora
Call Tiempo
End Sub
Sub Detener_reloj()
'Detiene el "OnTime"
Application.OnTime EarliestTime:=Now + TimeValue("00:00:01"), _
        Procedure:="Actualizarreloj", _
        Schedule:=False
End Sub
-------------------------------------------------
En codigo del formulario
Private Sub cmdSalir_Click()
''    ActiveWorkbook.Save  'Guarda posibles cambios de datos
'If MsgBox("¿Estás seguro que quieres cerrar?", vbYesNo) = vbYes Then 'mensage para salir
    Unload Me
Call Detener_reloj '"LLamado" a rutina que detiene el OnTime
    Sheets(1).Select
'Else
'    End If
    End Sub
----------------------------------------
¿Por qué en el objecto cmdSalir? Para que cuando cierre el formulario, se detenga el reloj
El evento OnTime de excel es bastante inestable y no suele controlarse bien a veces, de todas formas, intenta detener el contador con esta instrucción, en vez de esta:
Application.OnTime EarliestTime:=Now + TimeValue("00:00:01"), _
        Procedure:="Actualizarreloj", _
        Schedule:=False

Poner esta:
Application.OnTime Now + TimeValue("00:00:01"), "Actualizarreloj", , False
Las dos comas van así.
Espero que te sirva. Si no funciona así, plantéate de buscar un timer, ese evento que usas no está muy bien controlado por el programa.
Me da error esa linea, ahora bien.
Mi problema es el que menciono arriba, el cierre del formulario (aplicación) con mensaje. Agradezco si posible, releer el texto.
Si no se puede pues, no se puede, nadie se morirá por eso. Entiendo que algunas veces se presentan cangrejos de difícil solución, para mi es dificilísimo por mi capacidad en la materia.
Me dices si finalizo el tema, aun tienes otro mio je je
No pretendía cerrar el post amigo, si no que si no se solucionaba, tendría yo que descartar el post y que otra persona cogiera su duda.
En un principio la forma de cancelar el timer está bien, aquí hay un fallo que no me había percatado antes, no se cual es la función que pretende que haga lo que desea realizar.
¿Qué cuándo le diga que si, salga del formulario? ¿Y si le dice que no que siga el timer normalmente y no cierra el formulario?
Pues bien, si desea salir al darle a si, aunque haga un Unload, tiene que detener el reloj primero, ya que es un evento de Excel y hace una rellamada a esa macro, así que antes del Unload me, haga una llamada a detener el reloj.
Por otro lado al decirle que no usted tiene puesto que haga una parada del timer... no entiendo lo que pretende hacer al darle al botón cerrar. ¿O puede estar ahí el error?
Hol amigo.
Como puedes ver, esta ubicado el Call en el botón de cerrar la Aplicación (formulario)
Si le dices Si (cierra), cierra el formulario y que se dentenga el reloj
Si te equivocas de botón y le dices NOOOOOOOO, que se mantenga abierto el formulario y el reloj en funcionamiento
Hice el cambio ya repetido para cerciorarme mejor de su resultado y también ejecutando el mensaje(msgbox).
Private Sub cmdSalir_Click()
''    ActiveWorkbook.Save  'Guarda posibles cambios de datos
If MsgBox("¿Estás seguro que quieres cerrar?", vbYesNo) = vbYes Then 'mensage para salir
Call Detener_reloj '"LLamado" a rutina que detiene el OnTime
    Unload Me
    Sheets(1).Select
Else
    End If
    End Sub
Sin el msgbox funciona bien como dije anteriormente, sea antes del unload o después, si pongo el msgbox, me da error 1004 en tiempo de ejecución y es en este código
Sub Detener_reloj()
'Detiene el "OnTime"
Application.OnTime EarliestTime:=Now + TimeValue("00:00:01"), _
        Procedure:="Actualizarreloj", _
        Schedule:=False
End Sub
Efectivamente, te muestra el error porque llega a intentar ejecutar la parada del temporizador, y he estado mirando por ahí y efectivamente, como te comenté es un evento bastante inestable, he probado obviar el error 1004 sigue adelante pero no para el tiempo.
Pero he encontrado un temporizador que utiliza las Apis de Windows que seguro que funciona, es para excel 97 o superior.
Te pego aquí el código que seguro te va a servir, lo he probado y funciona correctamente.
Pega ésto en el Modulo.
Public Declare Function SetTimer Lib "user32" ( _
    ByVal HWnd As Long, _
    ByVal nIDEvent As Long, _
    ByVal uElapse As Long, _
    ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
    ByVal HWnd As Long, _
    ByVal nIDEvent As Long) As Long
Public TimerID As Long
Public TimerSeconds As Single
Sub StartTimer()
    TimerSeconds = 1 ' how often to "pop" the timer.
    TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub
Sub EndTimer()
    On Error Resume Next
    KillTimer 0&, TimerID
End Sub
Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
        ByVal nIDEvent As Long, ByVal dwTimer As Long)
    Formulario.LabHora = Time
End Sub

Elimina esto:
Sub Tiempo()
'Mediante esta instruccion "llamamos" a "Actualizarreloj" para volver a _
actualzizar el Label con la hora
  Application.OnTime Now + TimeValue("00:00:01"), _
        Procedure:="Actualizarreloj", _
        Schedule:=True
End Sub
Sub Actualizarreloj()
'Coloca la hora en el Label del UserForm
Formulario.LabHora = Time
'"Llama a la rutina que cada 01 segundo "llama" a "Actualizarreloj" para volver a _
actualzizar el Label con la hora
Call Tiempo
End Sub
Sub Detener_reloj()
'Detiene el "OnTime"
Application.OnTime EarliestTime:=Now + TimeValue("00:00:01"), _
        Procedure:="Actualizarreloj", _
        Schedule:=False
End Sub
para empezar el temporizador: call  StartTimer
para parar el temporizador: call  EndTimer
Se actualiza cada segundo.
Lo del if para salir, al darle que si, primero haz la llamada al call EndTimer y luego haz el unload.
Al final hemos encontrado una solución ;)
Una falla más pero por mi parte. No he mencionado la plataforma del SO, W7 X64 tengo instalado y estoy pensando en que si se hace la programación solo para X64 no funcionará en x86 y viceversa.
Pues me dice que ese código es para platafrma x86 y no x64 y hoy tengo x64 y en la oficina 2 x86 y 2 x64. ¿cómo hago?.
Agradezco tu paciencia y ademas la voluntad altruista de ayudar a resolver mi problema.
Un día me iré a la bermudez para agradecerte je je
Pues si que parece que hay un problema, pero declarando las funciones como 32 no se si funcionará bien...
Aquí explica un poco sobre ello: http://support.microsoft.com/kb/2210978 y aqui poner como realizarlo: http://support.microsoft.com/kb/180736/ es la misma forma que te comenté antes.
Y al final he encontrando una forma de declarar las funciones para que en 64 las ejecute como 32, donde pone esto en el código que te puse:
Public Declare Function SetTimer Lib "user32" ( _
    ByVal HWnd As Long, _
    ByVal nIDEvent As Long, _
    ByVal uElapse As Long, _
    ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
    ByVal HWnd As Long, _
    ByVal nIDEvent As Long) As Long

Borralo y en vez de eso pon esto, tal cual:
'Declare API
#If VBA7 Then
    Public Declare PtrSafe Function SetTimer Lib "user32" ( _
    ByVal HWnd As Long, _
    ByVal nIDEvent As Long, _
    ByVal uElapse As Long, _
    ByVal lpTimerFunc As Long) As Long
    Public Declare PtrSafe Function KillTimer Lib "user32" ( _
    ByVal HWnd As Long, _
    ByVal nIDEvent As Long) As Long
#Else
    Public Declare Function SetTimer Lib "user32" ( _
    ByVal HWnd As Long, _
    ByVal nIDEvent As Long, _
    ByVal uElapse As Long, _
    ByVal lpTimerFunc As Long) As Long
    Public Declare Function KillTimer Lib "user32" ( _
    ByVal HWnd As Long, _
    ByVal nIDEvent As Long) As Long
#End If

No tienes que tener problema ahora, con lo del timer nuevo...
Espero que te sirva, si no pues... creo que ya si que tendrías que mirar otra cosa, jajaja ;)
Agradezco tu buena voluntad para ayudarme, un esfuerzo bien empleado pero tomé una decisión, es Desistir del mensaje para quedar con el reloj en pantalla.
Gracias amigo y buena suerte

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas