Macro que combine varios archivos PDF en 1 solo
Me ayudaste a hacer esta macro:
Sub Macro3()
Dim ar1 As Variant, ar2 As Variant, f As Range, sh As Worksheet
Dim i As Long, ini As Long, fin As Long, sNom As String, n As Long
'
Set sh = Sheets("Resumen del dia")
ar1 = Array("E1", "T1", "E2", "T2", "E3", "T3", "E4", "T4", _
"E5", "T5", "E6", "T6", "E7", "T7")
ar2 = Array("B", "BG", "B", "BF", "B", "BF", "B", "BF", _
"E", "BH", "B", "BG", "E", "BH")
sh.Columns("A:A").EntireColumn.Hidden = False
'
For i = 0 To UBound(ar1) Step 2
Set f = sh.Range("A:A").Find(ar1(i), , xlValues, xlWhole)
If Not f Is Nothing Then
ini = f.Row
Set f = sh.Range("A:A").Find(ar1(i + 1), , xlValues, xlWhole)
If Not f Is Nothing Then
fin = f.Row
n = n + 1
sh.PageSetup.PrintArea = ar2(i) & ini & ":" & ar2(i + 1) & fin
sNom = Format(Date, "dd") & " de " & Application.WorksheetFunction.Proper(Format(Date, "mmmm")) & _
" de " & Format(Format(Date, "yyyy"), "#,##0") & " Hoja " & n
sh.ExportAsFixedFormat xlTypePDF, _
ThisWorkbook.Path & "\Cierres del Dia\Separados por Hojas\" & sNom & ".pdf", _
xlQualityStandard, True, False, , , False
End If
End If
Next
sh.Columns("A:A").EntireColumn.Hidden = True
End SubY asi como está es perfecta para lo que necesitaba, pero ahora me ha surgido una nueva tarea y es que debo unir cada uno de los 7 PDF creados en 1 solo llamado de la misma manera de los anteriores PDF creados solo que sin la parte "Hoja N".
Por ejemplo:
Se crearon:
15 de Junio de 2.020 Hoja 1 ... 2 ....3...4...5....6...7
Ahora la macro debe unirlos en 1 solo archivo PDF llamado "15 de Junio de 2.020.pdf" para ese ejemplo de esa fecha y debe ser guardado ese archivo único en la ruta:
ThisWorkbook.Path & "\Cierres del Dia\
1 Respuesta
Prueba la siguiente:
Sub Macro3()
Dim ar1 As Variant, ar2 As Variant, sh As Worksheet
Dim f As Range, cad1 As String, cad2 As String
Dim i As Long, ini As Long, fin As Long, sNom As String, n As Long
'
Set sh = Sheets("Resumen del dia")
ar1 = Array("E1", "T1", "E2", "T2", "E3", "T3", "E4", "T4", _
"E5", "T5", "E6", "T6", "E7", "T7")
ar2 = Array("B", "BG", "B", "BF", "B", "BF", "B", "BF", _
"E", "BH", "B", "BG", "E", "BH")
sh.Columns("A:A").EntireColumn.Hidden = False
'
For i = 0 To UBound(ar1) Step 2
Set f = sh.Range("A:A").Find(ar1(i), , xlValues, xlWhole)
If Not f Is Nothing Then
ini = f.Row
Set f = sh.Range("A:A").Find(ar1(i + 1), , xlValues, xlWhole)
If Not f Is Nothing Then
fin = f.Row
n = n + 1
cad1 = cad1 & ar2(i) & ini & ":" & ar2(i + 1) & fin & ","
cad2 = cad2 & n & "_"
End If
End If
Next
If cad1 <> "" Then
sh.PageSetup.PrintArea = Left(cad1, Len(cad1) - 1)
sNom = Format(Date, "dd") & " de " & Format(Date, "mmmm") & _
" de " & Format(Date, "yyyy") & " hoja " & Left(cad2, Len(cad2) - 1)
sh.ExportAsFixedFormat xlTypePDF, _
ThisWorkbook.Path & "\" & sNom & ".pdf", _
xlQualityStandard, True, False, , , False
End If
sh.Columns("A:A").EntireColumn.Hidden = True
End Sub
Te cuento que ya la ejecute, pero no realizo ninguna operación ni siquiera creo los archivos individuales.
Yo no se mucho de VBA pero igual de todos modos algo que me extrañó es que en ningún lado vi que ese archivo único pdf se guardara en :
ThisWorkbook.Path & "\Cierres del Dia\
Ruta distinta a la ruta de los archivos individuales que es:
ThisWorkbook.Path & "\Cierres del Dia\Separados por Hojas\"
Solamente va a crear un archivo, y lo crea en la misma carpeta donde tienes el archivo con la macro.
Si ya existe esta carpeta:
Cierres del Dia
Entonces modifica la macro y prueba, es una forma de aprender. Si no te funciona entonces prueba la siguiente:
Sub Macro3()
Dim ar1 As Variant, ar2 As Variant, sh As Worksheet
Dim f As Range, cad1 As String, cad2 As String
Dim i As Long, ini As Long, fin As Long, sNom As String, n As Long
'
Set sh = Sheets("Resumen del dia")
ar1 = Array("E1", "T1", "E2", "T2", "E3", "T3", "E4", "T4", _
"E5", "T5", "E6", "T6", "E7", "T7")
ar2 = Array("B", "BG", "B", "BF", "B", "BF", "B", "BF", _
"E", "BH", "B", "BG", "E", "BH")
sh.Columns("A:A").EntireColumn.Hidden = False
'
For i = 0 To UBound(ar1) Step 2
Set f = sh.Range("A:A").Find(ar1(i), , xlValues, xlWhole)
If Not f Is Nothing Then
ini = f.Row
Set f = sh.Range("A:A").Find(ar1(i + 1), , xlValues, xlWhole)
If Not f Is Nothing Then
fin = f.Row
n = n + 1
cad1 = cad1 & ar2(i) & ini & ":" & ar2(i + 1) & fin & ","
cad2 = cad2 & n & "_"
End If
End If
Next
If cad1 <> "" Then
sh.PageSetup.PrintArea = Left(cad1, Len(cad1) - 1)
sNom = Format(Date, "dd") & " de " & Format(Date, "mmmm") & _
" de " & Format(Date, "yyyy") & " hoja " & Left(cad2, Len(cad2) - 1)
sh.ExportAsFixedFormat xlTypePDF, _
ThisWorkbook.Path & "\Cierres del dia\" & sNom & ".pdf", _
xlQualityStandard, True, False, , , False
End If
sh.Columns("A:A").EntireColumn.Hidden = True
End Sub
