Cancelar el cierre de un fichero
Hola Experto,
A ver si me puedes ayudar.
He creado una macro que se ejecute al cerrar el fichero (sub auto_close()).
En esa macro se hace una pregunta y en función de la respuesta quisiera que se detuviera el cierre del fichero o que continuase el cierre del fichero.
¿Es posible?
Muchas gracias
A ver si me puedes ayudar.
He creado una macro que se ejecute al cerrar el fichero (sub auto_close()).
En esa macro se hace una pregunta y en función de la respuesta quisiera que se detuviera el cierre del fichero o que continuase el cierre del fichero.
¿Es posible?
Muchas gracias
1 Respuesta
Respuesta de mrtool
1
1
mrtool, Con mas de 15 años de experiencia en consultoria informatica en...
Si.
If (inputbox(la preguntaquequieras, etc..) = Yes then
continua
else
Para
Endif
If (inputbox(la preguntaquequieras, etc..) = Yes then
continua
else
Para
Endif
Gracias por tu respuesta, pero hay algo que debo de hacer mal. Supongo que sera algo que es lógico pero mi nivel no llega.
En la macro he puesto:
Sub auto_close()
'
'If (InputBox("¿quieres detener el cierre del fichero?")) = "s" Then
<span style="white-space: pre;"> </span>continua
Else
para
End If
End Sub
Y me da error de compilación en la linea de <span style......
¿Qué hago mal?
Saludos
En la macro he puesto:
Sub auto_close()
'
'If (InputBox("¿quieres detener el cierre del fichero?")) = "s" Then
<span style="white-space: pre;"> </span>continua
Else
para
End If
End Sub
Y me da error de compilación en la linea de <span style......
¿Qué hago mal?
Saludos
. Salido en mi respuesta eso del 'span' que es código HTML, se ve que algo raro del copy paste.
De todas formas lo que te escribía era pseudocodigo. Hay que ponerlo en código correcto.
En los huecos del 'para' o 'sigue' debes incluir el código que necesites, en función de tu macro, para que continué o no haga nada.
Si me pegas la macro lo mismo te puedo ayudar mejor.
De todas formas lo que te escribía era pseudocodigo. Hay que ponerlo en código correcto.
En los huecos del 'para' o 'sigue' debes incluir el código que necesites, en función de tu macro, para que continué o no haga nada.
Si me pegas la macro lo mismo te puedo ayudar mejor.
Gracias por tu respuesta.
Mi problema es que conocer el código necesario para que se paralice el proceso de cierre del fichero sin llegar al cuadro de dialogo que saca excel diciendo si quieres guardar los cambios.
Para no poner toda la macro, te pongo un resumen de lo que quisiera que hiciera. Lo que no se hacer es que poner donde están las interrogaciones para que el proceso de cierre se cancele y deje el fichero abierto.
Sub auto_close()
pregunta = InputBox("¿quieres cancelar el proceso de cierre de este fichero? (s/n)")
if pregunta = "s" then ???????
End Sub
Saludos
Mi problema es que conocer el código necesario para que se paralice el proceso de cierre del fichero sin llegar al cuadro de dialogo que saca excel diciendo si quieres guardar los cambios.
Para no poner toda la macro, te pongo un resumen de lo que quisiera que hiciera. Lo que no se hacer es que poner donde están las interrogaciones para que el proceso de cierre se cancele y deje el fichero abierto.
Sub auto_close()
pregunta = InputBox("¿quieres cancelar el proceso de cierre de este fichero? (s/n)")
if pregunta = "s" then ???????
End Sub
Saludos
Hola no se si te ayudará, pero te pongo la macro entera, como me pedías
Sub comprobar_repes()
'
'
Columns("V:X").Select
If Selection.EntireColumn.Hidden = True Then Selection.EntireColumn.Hidden = False
Range("A1").Select
Selection.AutoFilter Field:=1, Criteria1:=1, Operator:=xlAnd
ActiveSheet.ShowAllData
hayrepes = 0
hayblancos = 0
pregunta = "n"
Application.Goto Reference:="R65535C6"
Selection.End(xlUp).Select
ultimafila = ActiveCell.Row
If ultimafila > 5000 Then
MsgBox ("El número de filas es superior a la considerada en la programación. Por favor, contacte para modificar la programación.")
GoTo 100
End If
Application.Goto Reference:="R2C23"
ActiveCell.Columns("A:A").EntireColumn.Select
Selection.ClearContents
Application.Goto Reference:="R2C23"
ActiveCell.FormulaR1C1 = "=+COUNTIF(R2C3:R5000C3,RC[-20])"
ActiveCell.Select
Selection.Copy
Application.Goto Reference:="R65535C6"
Selection.End(xlUp).Select
ActiveCell.Offset(0, 17).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
For i = 2 To ultimafila
destino = "R" & i & "C23"
Application.Goto Reference:=destino
numerorepe = Selection
If numerorepe > 1 Then
hayrepes = 1
texto1 = "Hay datos REPETIDAS en la columna de nº producto servicio. Esto creará problemas a la hora de realizar la fusión con el fichero de que recibas. Es aconsejable revisar estas incidencias. ¿Deseas realizarlo ahora?"
texto2 = "Para repasar las datos REPETIDAS pulsa 'Cancelar' en el PROXIMO recuadro"
fila = ActiveCell.Row
celdaerronea = "R" & fila & "C3"
criterio = ">1"
i = ultimafila
End If
If numerorepe = 0 Then
hayrepes = 1
texto1 = "Hay datos EN BLANCO en la columna de nº producto servicio. Esto creará problemas a la hora de realizar la fusión con el fichero que recibas. Es aconsejable revisar estas incidencias. ¿Deseas realizarlo ahora?"
texto2 = "Para repasar las datos VACIAS pulsa 'Cancelar' en el PROXIMO recuadro"
fila = ActiveCell.Row
celdaerronea = "R" & fila & "C3"
criterio = "<1"
i = ultimafila
End If
Next i
If hayrepes = 1 Then pregunta = InputBox(texto1, "repe", "S")
If pregunta = "s" Then pregunta = "S"
Application.Goto Reference:="R65535C123"
ActiveCell.FormulaR1C1 = pregunta
If pregunta = "S" Then
Application.Goto Reference:="R1C3"
Range("A2:z5000").Sort Key1:=Range("C2"), Order1:=xlAscending, Header:= _
xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.AutoFilter Field:=23, Criteria1:=criterio, Operator:=xlAnd
MsgBox (texto2)
Application.Goto Reference:=celdaerronea
GoTo 100
End If
Selection.AutoFilter Field:=1, Criteria1:=1, Operator:=xlAnd
ActiveSheet.ShowAllData
Application.Goto Reference:="R1C3"
Range("A2:z5000").Sort Key1:=Range("a2"), Order1:=xlAscending, Header:= _
xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.Goto Reference:="R1C23"
ActiveCell.FormulaR1C1 = "No utilizar esta columna"
ActiveCell.Select
Selection.Copy
Application.Goto Reference:="R65535C6"
Selection.End(xlUp).Select
ActiveCell.Offset(0, 17).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.Goto Reference:="R1C23"
Columns("W:W").Select
Selection.EntireColumn.Hidden = True
Application.Goto Reference:="R1C1"
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.Offset(-1, -1).Range("A1").Select
100 End Sub
Sub auto_close()
nombreusuario = Environ("username")
If nombreusuario = "antonio" Then usuarioautorizado = 1
If nombreusuario = "jose" Then usuarioautorizado = 1
If usuarioautorizado = 1 Then
comprobar_repes
Application.Goto Reference:="R65535C123"
pregunta = Selection
Selection.ClearContents
If pregunta <> "S" Then proteger
End If
Application.Goto Reference:="R2C4"
'
Selection.End(xlDown).Select
Selection.End(xlUp).Select
Application.Goto Reference:="R2C3"
End Sub
Sub proteger()
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True
End Sub
Muchas gracias
Sub comprobar_repes()
'
'
Columns("V:X").Select
If Selection.EntireColumn.Hidden = True Then Selection.EntireColumn.Hidden = False
Range("A1").Select
Selection.AutoFilter Field:=1, Criteria1:=1, Operator:=xlAnd
ActiveSheet.ShowAllData
hayrepes = 0
hayblancos = 0
pregunta = "n"
Application.Goto Reference:="R65535C6"
Selection.End(xlUp).Select
ultimafila = ActiveCell.Row
If ultimafila > 5000 Then
MsgBox ("El número de filas es superior a la considerada en la programación. Por favor, contacte para modificar la programación.")
GoTo 100
End If
Application.Goto Reference:="R2C23"
ActiveCell.Columns("A:A").EntireColumn.Select
Selection.ClearContents
Application.Goto Reference:="R2C23"
ActiveCell.FormulaR1C1 = "=+COUNTIF(R2C3:R5000C3,RC[-20])"
ActiveCell.Select
Selection.Copy
Application.Goto Reference:="R65535C6"
Selection.End(xlUp).Select
ActiveCell.Offset(0, 17).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
For i = 2 To ultimafila
destino = "R" & i & "C23"
Application.Goto Reference:=destino
numerorepe = Selection
If numerorepe > 1 Then
hayrepes = 1
texto1 = "Hay datos REPETIDAS en la columna de nº producto servicio. Esto creará problemas a la hora de realizar la fusión con el fichero de que recibas. Es aconsejable revisar estas incidencias. ¿Deseas realizarlo ahora?"
texto2 = "Para repasar las datos REPETIDAS pulsa 'Cancelar' en el PROXIMO recuadro"
fila = ActiveCell.Row
celdaerronea = "R" & fila & "C3"
criterio = ">1"
i = ultimafila
End If
If numerorepe = 0 Then
hayrepes = 1
texto1 = "Hay datos EN BLANCO en la columna de nº producto servicio. Esto creará problemas a la hora de realizar la fusión con el fichero que recibas. Es aconsejable revisar estas incidencias. ¿Deseas realizarlo ahora?"
texto2 = "Para repasar las datos VACIAS pulsa 'Cancelar' en el PROXIMO recuadro"
fila = ActiveCell.Row
celdaerronea = "R" & fila & "C3"
criterio = "<1"
i = ultimafila
End If
Next i
If hayrepes = 1 Then pregunta = InputBox(texto1, "repe", "S")
If pregunta = "s" Then pregunta = "S"
Application.Goto Reference:="R65535C123"
ActiveCell.FormulaR1C1 = pregunta
If pregunta = "S" Then
Application.Goto Reference:="R1C3"
Range("A2:z5000").Sort Key1:=Range("C2"), Order1:=xlAscending, Header:= _
xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.AutoFilter Field:=23, Criteria1:=criterio, Operator:=xlAnd
MsgBox (texto2)
Application.Goto Reference:=celdaerronea
GoTo 100
End If
Selection.AutoFilter Field:=1, Criteria1:=1, Operator:=xlAnd
ActiveSheet.ShowAllData
Application.Goto Reference:="R1C3"
Range("A2:z5000").Sort Key1:=Range("a2"), Order1:=xlAscending, Header:= _
xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.Goto Reference:="R1C23"
ActiveCell.FormulaR1C1 = "No utilizar esta columna"
ActiveCell.Select
Selection.Copy
Application.Goto Reference:="R65535C6"
Selection.End(xlUp).Select
ActiveCell.Offset(0, 17).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.Goto Reference:="R1C23"
Columns("W:W").Select
Selection.EntireColumn.Hidden = True
Application.Goto Reference:="R1C1"
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.Offset(-1, -1).Range("A1").Select
100 End Sub
Sub auto_close()
nombreusuario = Environ("username")
If nombreusuario = "antonio" Then usuarioautorizado = 1
If nombreusuario = "jose" Then usuarioautorizado = 1
If usuarioautorizado = 1 Then
comprobar_repes
Application.Goto Reference:="R65535C123"
pregunta = Selection
Selection.ClearContents
If pregunta <> "S" Then proteger
End If
Application.Goto Reference:="R2C4"
'
Selection.End(xlDown).Select
Selection.End(xlUp).Select
Application.Goto Reference:="R2C3"
End Sub
Sub proteger()
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True
End Sub
Muchas gracias
La macro es pelín liosilla :-)
Prueba a usar este truco.
Cuando la pregunta sea 'no' es decir no quieras salvar pon este código:
ThisWorkbook.Saved=True 'Engañamos a excel diciendo que ya se salvó.
ThisWorkbook. Close ' Cerramos el excel
Prueba a usar este truco.
Cuando la pregunta sea 'no' es decir no quieras salvar pon este código:
ThisWorkbook.Saved=True 'Engañamos a excel diciendo que ya se salvó.
ThisWorkbook. Close ' Cerramos el excel
Gracias Mrtool
Realmente no es eso lo que quiero, ya que de esa forma cierro el fichero sin guardar los cambios, cuando lo que realmente quiero es detenga el cierre del fichero para realizar una serie de comprobaciones puesto que hay datos repetidos y el usuario debe decidir si realmente deben estar repetidos o es un error.
Tal vez no sea posible hacer lo que quiero.
¿Existe algún código que elija la respuesta del PRÓXIMO cuadro de dialogo que va a aparecer?. Si existiera ese código, le podría elegir la respuesta (cancelar) del cuadro que saca excel para decirte "si deseas guardar los cambios"
En cualquier caso muchas gracias por tu ayuda.
Saludos
Realmente no es eso lo que quiero, ya que de esa forma cierro el fichero sin guardar los cambios, cuando lo que realmente quiero es detenga el cierre del fichero para realizar una serie de comprobaciones puesto que hay datos repetidos y el usuario debe decidir si realmente deben estar repetidos o es un error.
Tal vez no sea posible hacer lo que quiero.
¿Existe algún código que elija la respuesta del PRÓXIMO cuadro de dialogo que va a aparecer?. Si existiera ese código, le podría elegir la respuesta (cancelar) del cuadro que saca excel para decirte "si deseas guardar los cambios"
En cualquier caso muchas gracias por tu ayuda.
Saludos
El problema es que una vez que haces la llamada al 'close' Excel toma el control y tienes un poco limitadas las opciones.
Quizás lo más sencillo fuera incluir el código en un botón 'salvar' o cerrar de forma que lo controles todo.
Otra posible que se me ocurre ahora mismo ( y no se si fucnionaria) seria hacer una llamada recurrente al 'comprueba repeticiones' de forma que mientras sigas teniendo valores 'malos' el programa se llame siempre a si mismo ..
Quizás lo más sencillo fuera incluir el código en un botón 'salvar' o cerrar de forma que lo controles todo.
Otra posible que se me ocurre ahora mismo ( y no se si fucnionaria) seria hacer una llamada recurrente al 'comprueba repeticiones' de forma que mientras sigas teniendo valores 'malos' el programa se llame siempre a si mismo ..
Hola Mrtool,
Buceando por el ciber espacio he encontrado la inspiración con la sentencia sendkeys
La siguiente macro paraliza el cierre del fichero si la respuesta es "s".
Sub auto_close()
'
pregunta = InputBox("¿desea cancelar el cierre del fichero? (s/n)")
If pregunta = "s" Then SendKeys "{escape}"
End Sub
De todas formas muchas gracias por tus respuestas e interés. Gracias
Buceando por el ciber espacio he encontrado la inspiración con la sentencia sendkeys
La siguiente macro paraliza el cierre del fichero si la respuesta es "s".
Sub auto_close()
'
pregunta = InputBox("¿desea cancelar el cierre del fichero? (s/n)")
If pregunta = "s" Then SendKeys "{escape}"
End Sub
De todas formas muchas gracias por tus respuestas e interés. Gracias
- Compartir respuesta
- Anónimo
ahora mismo