Macro que crea un pdf de un libro entero y lo archive automáticamente en determinada carpeta
Mi problema es que tengo que hacer ccada semana con 10 libros que tiene más o menos diez hojas, tengo que convertirlos en 10 pdf, que cada uno contenga las diez hojas y se renombren como la primera hoja+una celda dentro de esa hoja y después archivarlo cada uno en una ruta diferente. Me gustaría saber si hay una macro primero que cree el PDF de cada libro, segundo se renombre y por último se archive directamente y esto multiplicado por los 10 libros. ¿Es posible?
1 respuesta
H o l a:
En un libro nuevo, en la "Hoja1", pon las siguientes columnas:
En la A, la ruta del archivo excel.
En la B, el nombre del archivo excel con todo y extensión.
En la C, el nombre de la hoja del archivo de excel.
En la D, la celda que contiene el nombre para el archivo Pdf.
En la E, la ruta donde quieres que se guarde el archivo Pdf.
En la columna "F" la macro pone el resultado de generar el Pdf.
Pon la siguiente macro en un botón:
Sub GenerarPdf()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Hoja1")
u = h1.Range("A" & Rows.Count).End(xlUp).Row
If u < 2 Then u = 2
h1.Range("F2:F" & u).ClearContents
For i = 2 To u
ruta1 = h1.Cells(i, "A")
If Right(ruta1, 1) <> "\" Then ruta1 = ruta1 & "\"
If Dir(ruta1, vbDirectory) <> "" Then
arch1 = h1.Cells(i, "B")
If Dir(ruta1 & arch1) <> "" Then
ruta2 = h1.Cells(i, "E")
If Right(ruta2, 1) <> "\" Then ruta2 = ruta2 & "\"
If Dir(ruta2, vbDirectory) <> "" Then
hoja = h1.Cells(i, "C")
Set l2 = Workbooks.Open(ruta1 & arch1)
existe = False
For Each h In l2.Sheets
If UCase(h.Name) = UCase(hoja) Then
existe = True
Exit For
End If
Next
If existe Then
celda = l2.Sheets(hoja).Range(h1.Cells(i, "D").Value)
If IsDate(celda) Then
celda = Format(celda, "dd-mmm-yyyy")
End If
nomb = hoja & " " & celda
l2.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ruta2 & nomb & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
l2.Close
h1.Cells(i, "F") = "PDF generado"
Else
h1.Cells(i, "F") = "La hoja no existe"
End If
Else
h1.Cells(i, "F") = "La ruta destino no existe"
End If
Else
h1.Cells(i, "F") = "El archivo excel no existe"
End If
Else
h1.Cells(i, "F") = "La ruta del archivo excel no existe"
End If
Next
Application.ScreenUpdating = True
MsgBox "Archivos PDF generados", vbInformation, "GENERAR PDF"
End Sub':) 'S aludos. D a n t e A m o r . R ecuerda valorar la respuesta. G racias ':)
