Dudas en una macro
Buenas,
Tengo esta macro que cuando la ejecuto me guarda el libro en un a carpeta específica.
Lo que quiero es que cuando alguien trabaje con el liro, y lo cierre, al cerrar haga una copia del libro independientemente de donde la guarde el usuario.
Quiero que el archivo se sobrescriba siempre con el mismo nombre.
La macro es la siguiente:
Sub Copia_Libro()
Dim ruta, carpeta, libro, texto As String
ruta = "C:\Cartera Ofertas\"
carpeta = "2007"
libro = "Cartera Ofertas"
texto = ruta & carpeta & "\" & libro & ".xls"
ActiveWorkbook.SaveAs Filename:=texto, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
Tengo esta macro que cuando la ejecuto me guarda el libro en un a carpeta específica.
Lo que quiero es que cuando alguien trabaje con el liro, y lo cierre, al cerrar haga una copia del libro independientemente de donde la guarde el usuario.
Quiero que el archivo se sobrescriba siempre con el mismo nombre.
La macro es la siguiente:
Sub Copia_Libro()
Dim ruta, carpeta, libro, texto As String
ruta = "C:\Cartera Ofertas\"
carpeta = "2007"
libro = "Cartera Ofertas"
texto = ruta & carpeta & "\" & libro & ".xls"
ActiveWorkbook.SaveAs Filename:=texto, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
1 Respuesta
Respuesta de snd_alx
1
Existe un evento que ocurre justo antes de cerrarse el libro que es el apropiado para replicar tu archivo antes de cerrarse en el lugar que desees.
El objeto ThisWorkbook dispone del evento BeforeClose (antes de cerrarse) donde puedes ejecutar el código que desees.
<En el objeto ThisWorkbook>
Private Sub Workbook_BeforeClose(Cancel As Boolean)
call Copia_Libro
End Sub
El objeto ThisWorkbook dispone del evento BeforeClose (antes de cerrarse) donde puedes ejecutar el código que desees.
<En el objeto ThisWorkbook>
Private Sub Workbook_BeforeClose(Cancel As Boolean)
call Copia_Libro
End Sub
Ha funcionado muy bien, es lo que necesitaba. Pero al guardarlo en la misma ruta me pide si lo quiero sustituir. Lo que me interesa es que lo sustituya automáticamente.
No se si el excel dispone de algún parámetro en la función Saveas para indicar por defecto que se quiere sobreescribir, así que te he agregado unas pocas lineas de código que lo que hacen es guardar inicialmente el archivo con el nombre "TEMP" al final, borrar el archivo anterior y renombrar el acabado en "TEMP" con el nombre original.
Tiene sus riesgos, pruébalas con precaución (haz un backup de tu archivo con cierta regularidad y antes de probar la macro).
Te he puesto un control de errores para que si ocurre algún problema no borre el archivo original, pero aun que ahora no se me ocurren, tal vez existan circunstancias bajo las cuales pueda ocurrir un borrado no deseado (tampoco es que quiera alarmarte ^^)
Sub Copia_Libro()
On error goto HandError
Dim ruta, carpeta, libro, texto As String
ruta = "C:\Cartera Ofertas\"
carpeta = "2007"
libro = "Cartera Ofertas"
texto = ruta & carpeta & "\" & libro & "TEMP" & ".xls"
ActiveWorkbook.SaveAs Filename:=texto, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Dim Archivo As String
Dim Archivo_Aux As String
Dim Fs
Set Fs = CreateObject("Scripting.FileSystemObject")
Archivo = ruta & carpeta & "\" & libro & ".xls"
Archivo_Aux = ruta & carpeta & "\" & libro & "TEMP" & ".xls"
Fs.DeleteFile Archivo
Name Archivo_Aux As Archivo
exit sub
HandError:
exit sub
End Sub
Tiene sus riesgos, pruébalas con precaución (haz un backup de tu archivo con cierta regularidad y antes de probar la macro).
Te he puesto un control de errores para que si ocurre algún problema no borre el archivo original, pero aun que ahora no se me ocurren, tal vez existan circunstancias bajo las cuales pueda ocurrir un borrado no deseado (tampoco es que quiera alarmarte ^^)
Sub Copia_Libro()
On error goto HandError
Dim ruta, carpeta, libro, texto As String
ruta = "C:\Cartera Ofertas\"
carpeta = "2007"
libro = "Cartera Ofertas"
texto = ruta & carpeta & "\" & libro & "TEMP" & ".xls"
ActiveWorkbook.SaveAs Filename:=texto, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Dim Archivo As String
Dim Archivo_Aux As String
Dim Fs
Set Fs = CreateObject("Scripting.FileSystemObject")
Archivo = ruta & carpeta & "\" & libro & ".xls"
Archivo_Aux = ruta & carpeta & "\" & libro & "TEMP" & ".xls"
Fs.DeleteFile Archivo
Name Archivo_Aux As Archivo
exit sub
HandError:
exit sub
End Sub
