Cerrar y borrar libros
Una tarea común en Excel es abrir archivos de datos, tomar alguna información y cerrar el archivo para no abrirlo nunca más. Con el tiempo, estos archivos temporales van creciendo, a menos que los borremos meticulosamente. Este código añade una nueva opción al menú Archivo: Cerrar y Borrar. Esto permite que el libro activo se cierre y elimine. También elimina el nombre de archivo de la lista de archivos abiertos recientemente.
Sub Workbook_AddinInstall()
Dim cmdControl As CommandBarButton
On Error Resume Next
Set cmdControl = Application.CommandBars(1).Controls("File").Controls(CONTROLNAME)
If cmdControl Is Nothing Then
Set cmdControl = Application.CommandBars(1).Controls("File").Controls.Add(Type:=msoControlButton, Before:=Application.CommandBars(1).Controls("File").Controls("Save").Index)
With cmdControl
.Caption = CONTROLNAME
.FaceId = 67
.Style = msoButtonIconAndCaption
.DescriptionText = "Close and delete the current workbook"
.OnAction = "CloseAndKill"
End With
Set cmdControl = Nothing
End If
On Error GoTo 0
MsgBox "Cerrar y borrar está disponible en el menú Archivo"
End Sub
Sub Workbook_AddinUninstall()
On Error Resume Next
Application.CommandBars(1).Controls("File").Controls(CONTROLNAME).Delete
MsgBox "Close and Delete is no longer available from the File Menu"
End Sub
Sub CloseAndKill()
Dim tmpAnswer As Variant
If ActiveWorkbook Is Nothing Then Exit Sub
tmpAnswer = MsgBox("Estás seguro de querer borrar " & _
ActiveWorkbook.FullName & """?", _
vbYesNoCancel + vbInformation)
If tmpAnswer = vbYes Then
Dim tmpFileName As String
Dim RecentFle As RecentFile
tmpFileName = ActiveWorkbook.FullName
'esto elimina el archivo de la lista de archivos recientemente utilizados de modo que no podemos abrirlo de nuevo
For Each RecentFle In Application.RecentFiles
If RecentFle.Path = tmpFileName Then RecentFle.Delete
Next
ActiveWorkbook.Close SaveChanges:=False
On Error Resume Next
Kill tmpFileName 'Elimina el archivo
If Err.Number <> 0 Then
MsgBox "No se puede eliminar """ & tmpFileName & """."
End If
End If
End Sub
Si te ha parecido interesante, comparte: Compartir
