Macro para guardar hojas de excel en formato PDF
Necesito crear una macro que me guarde dos hojas específicas de un archivo de Excel en dos archivos nuevos independientes, uno en excel y otro en PDF, y que ambos archivos se guarden en la misma carpeta donde se encuentra el archivo origen. Los nombres de los archivos nuevos deberían ser el contenido de la celda R1.
Ejemplo: Archivo de excel guardado en carpeta Escritorio con cuatro hojas. Las hojas "Hoja1" y "Hoja2", son las que necesito guardar en dos archivos independientes y que lleven por título el contenido de la celda R1 de la "Hoja1". Ambos archivos guardarlos en carpeta escritorio.
El resultado debería ser, un archivo .xls con dos hojas "Hoja1" y "Hoja2" y otro archivo .pdf con el contenido de "Hoja1" y "Hoja2".
3 respuestas
Te dejo la macro que tendrás que colocarla en el Editor, en un módulo. El código va explicado por lo que no tendrás inconvenientes en ajustar detalles.
Para ejecutarla podrás optar por llamarla desde menú Macros, un botón o un atajo de teclado... estos temas los tengo explicados en la sección Macros de mi sitio que dejo al pie. Cualquier duda me comentas.
Sub CopiaHoja()
'x Elsamatilde
'Macro extraída y adaptada del manual 500Macros, cap.17.13
'ruta y nbre para la hoja
ruta = ThisWorkbook.Path
nbreHo = Sheets("Hoja1").[R1]
'copiamos las 2 hojas solicitadas
Sheets(Array("Hoja1", "Hoja2")).Copy
'creamos un nuevo objeto Libro
Set wb = ActiveWorkbook
On Error Resume Next
With wb
'guardamos el libro en la misma carpeta y cuyo nombre es el contenido de R1 de Hoja1
.SaveAs ThisWorkbook.Path & "\" & nbreHo & ".xlsx"
'se guarda también como PDF
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ruta & "\" & nbreHo & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'cerramos el nuevo libro
.Close
End With
'se libera el objeto
Set wb = Nothing
'opcional:
MsgBox "Fin del proceso"
End Sub
Te anexo la macro
Sub Guardar_Hojas()
'Por Dante Amor
' Guardar hoja1 y hoja2 como excel y pdf
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
Set h3 = Sheets(Array(h1.Name, h2.Name))
ruta = ThisWorkbook.Path & "\"
arch = h1.Range("R1").Value
'
h3.Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ruta & arch & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
h3.Copy
ActiveWorkbook.SaveAs Filename:=ruta & arch & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
MsgBox "Archivos creados"
End Sub'.[Sal u dos. Dante Amor. No olvides valorar la respuesta.
