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
1

1 respuesta

Respuesta
1
Si.
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
. 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.
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
Mejor ponme toda la macro que será más fácil.
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
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
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
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 ..
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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas