Cómo ejecutar un bucle hasta que se presione una tecla.
Tengo una macro en excel que es un timer, al llegar a cero emite una alarma y hace parpadear una celda. Quiero que haga esto hasta que se presione una tecla del teclado y/o se haga clic con el mouse pero no encuentro una fución para leer entrada. (No uso formulario, lo hago desde la hoja de trabajo). ¿Alguien sabe la función o como hacerlo? No he encontrado nada en google.
Una disculpa se me pasó poner el código. Aquí está:
Dim Cuenta1 As Range
Dim ejecutando1 As Boolean
Dim NO1 As String
Public Iniciar1 As Date
Sub setcrono1()
ejecutando1 = True
Set Cuenta1 = [K3]
[F3] = [K3]
Call ProgramaCuentaRegresiva1
End Sub
Sub ProgramaCuentaRegresiva1()
Iniciar1 = Now + TimeValue("00:00:01")
Application.OnTime Earliesttime:=Iniciar1, procedure:="ProgramaCuenta1", Schedule:=True
End Sub
Sub ProgramaCuenta1()
Dim s As Integer
Dim hora As String
Set Cuenta1 = [F3]
Cells(3, 7).Interior.ColorIndex = 2
Cuenta1.Value = Cuenta1.Value - TimeSerial(0, 0, 1)
If Cuenta1 <= 0 Then
hora = Format(Now, "HH:mm:ss")
If hora > "15:30:00" Then
Call EnviarEmail1
End If
For i = 0 To 1
Call SonidoControlado
For q = 0 To 2500
Cells(3, 7).Interior.ColorIndex = 3
Next
q = 0
For q = 0 To 2500
Cells(3, 7).Interior.ColorIndex = 2
Next
Next
Cells(3, 7).Interior.ColorIndex = 3
NO1 = Sheet1.Range("B3").Text
MsgBox "Terminó el Tiempo de Proceso Traveler " + NO1, vbExclamation
Call apagarcrono1
Exit Sub
End If
Call ProgramaCuentaRegresiva1
End Sub
Sub apagarcrono1()
ejecutando = False
On Error Resume Next
Application.OnTime Earliesttime:=Iniciar1, procedure:="ProgramaCuenta1", Schedule:=False
End Sub
La parte que necesito que se repita es:
For i = 0 To 1 Call SonidoControlado For q = 0 To 2500 Cells(3, 7).Interior.ColorIndex = 3 Next q = 0 For q = 0 To 2500 Cells(3, 7).Interior.ColorIndex = 2 Next
En lugar del For i=0 .... poner algo como do while hasta que se presione enter o space
No se puede poner una tecla, ya que la definición On Key funciona llamando a una macro, pero ya tienes una macro en ejecución.
Prueba lo siguiente, tu macro quedaría así:
Sub ProgramaCuenta1()
Dim s As Integer
Dim hora As String
Set Cuenta1 = [F3]
Cells(3, 7).Interior.ColorIndex = 2
Cuenta1.Value = Cuenta1.Value - TimeSerial(0, 0, 1)
If Cuenta1 <= 0 Then
hora = Format(Now, "HH:mm:ss")
If hora > "15:30:00" Then
Call EnviarEmail1
End If
'
Cells(3, "H") = ""
parpadear
'
Cells(3, 7).Interior.ColorIndex = 3
NO1 = Sheet1.Range("B3").Text
MsgBox "Terminó el Tiempo de Proceso Traveler " + NO1, vbExclamation
Call apagarcrono1
Exit Sub
End If
Call ProgramaCuentaRegresiva1
End SubEn otro módulo pon la siguiente macro:
Sub parpadear()
If Cells(3, 8) <> "" Then
Exit Sub
End If
Call SonidoControlado
If Cells(3, 7).Interior.ColorIndex = 3 Then
Cells(3, 7).Interior.ColorIndex = 2
Else
Cells(3, 7).Interior.ColorIndex = 3
End If
Application.OnTime Earliesttime:=Now + TimeValue("00:00:01"), procedure:="parpadear", Schedule:=True
End SubLo que hace es ejecutar la macro parpadear hasta que la celda H3 sea igual a blanco, si escribes algo en la celda H3, entonces se detendrá la macro papadear.
Prueba y me comentas.
':) S a l u d o s . D a n t e A m o r ':) Si es lo que necesitas. Recuerda valorar la respuesta. G r a c i a s.
Gracias Dante por tu ayuda.
Hice algunas modificaciones pero básicamente es el código que me pasaste. Quedo de esta manera:
Sub setcrono1()
ejecutando1 = True
Set Cuenta1 = [K3]
[G3] = [K3]
Call ProgramaCuentaRegresiva1
End Sub
Sub ProgramaCuentaRegresiva1()
Iniciar1 = Now + TimeValue("00:00:01")
Application.OnTime Earliesttime:=Iniciar1, procedure:="ProgramaCuenta1", Schedule:=True
End Sub
Sub ProgramaCuenta1()
Dim NO1 As String
Dim s As Integer
Dim hora As String
Set Cuenta1 = [G3]
Cells(3, 8).Interior.ColorIndex = 2
Cuenta1.Value = Cuenta1.Value - TimeSerial(0, 0, 1)
If Cuenta1 <= 0 Then
hora = Format(Now, "HH:mm:ss")
If hora > "15:30:00" Then
Call EnviarEmail1
End If
NO1 = Sheet1.Range("B3").Text
Sheet1.Range("J3") = ""
Cells(3, "J") = ""
Call avisa(NO1)
Cells(3, 8).Interior.ColorIndex = 3
Call apagarcrono1
Exit Sub
End If
Call ProgramaCuentaRegresiva1
End Sub
Sub apagarcrono1()
ejecutando = False
On Error Resume Next
Application.OnTime Earliesttime:=Iniciar1, procedure:="ProgramaCuenta1", Schedule:=False
End SubY la función parpadear que la renombre avisa quedo:
Sub avisa(Optional NO As String)
SO1 = NO
Sheet1.Range("J3").Select
If Cells(3, 10) <> "" Then
SO1 = NO
MsgBox "Terminó el Tiempo de Proceso del Traveler " + SO1, vbExclamation
Exit Sub
End If
Call SonidoControlado
For q = 0 To 1000
Cells(3, 8).Interior.ColorIndex = 3
Next
q = 0
For q = 0 To 1000
Cells(3, 8).Interior.ColorIndex = 2
Next
Application.OnTime Earliesttime:=Now + TimeValue("00:00:01"), procedure:="avisa", Schedule:=True
End Subpor cierto en esta ultimo tengo problemas para guardar el valor de la variable NO que le estoy enviando como argumento si lo recibe pero despues de algunas iteraciones se vacía y no aparece en el msg box (variable SO1). Será por la función application.ontime?
H o l a:
Si probaste la macro que te envié hace lo que solicitaste, la celda va a parpadear hasta que escribas algo.
Como te expliqué no es posible que mediante una tecla se pueda detener el parpadeo, ya que el parpadeo es originado por una macro que está en ejecución.
Otra parte que actualicé en la macro es esto:
For q = 0 To 1000 Cells(3, 8).Interior.ColorIndex = 3 Next
Lo que hace esa parte es poner 1000 veces el mismo color 3 a la celda, entonces no parpadea, para lograr el efecto de parpadear, podría ser así:
If Cells(3, 7).Interior.ColorIndex = 3 Then Cells(3, 7).Interior.ColorIndex = 2 Else Cells(3, 7).Interior.ColorIndex = 3 End If
Lo pone en color 2, a la siguiente vez lo pone en color 3 y así sucesivamente.
Por otra parte, para que la variable NO conserve su valor, declara la variable NO como pública, pero al principio de todas las macros.
':) 'S aludos. D a n t e A m o r . R ecuerda valorar la respuesta. G racias ':)
¿
Puedes escribirme a mi correo o darme el tuyo para pasarte el archivo y explicarte un poco mejor?
La macro que te envié, ya la probé y funciona bien, la celda está parpadeando y cuando escribes algo en la celda, deja de parpadear.
Ya se que pediste que una tecla detenga el parpadeo, pero como ya te expliqué, eso no es posible ya que una macro está en ejecución. Es por eso que te pido que valores la respuesta.
Sin embargo, este es mi correo:
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Luis de la torre” y el título de esta pregunta.
