Guardar múltiples PDFs al encontrar un Subtotal
Estimados necesito de su ayuda con lo siguiente: tengo una macro que guarda un PDF cada vez que encuentra un salto de Página (ActiveSheet. HPageBreaks). Le agregué Subtotales mediante la función, al archivo con el cual estoy trabajando y hay clientes cuyo reporte solo es de 1 página y la macro guarda un PDF con los datos de ese cliente, pero otros tienen reportes que van desde 2 hasta por cantidad de páginas y la macro me guarda tantos PDF como páginas tiene ese cliente. La idea es modificar la macro para que pueda guardar un solo PDF con la cantidad de hojas que tenga al encontrar un Subtotal (Ubicados en la columna "B") y no al encontrar un salto de página. Acá el código que tengo actualmente:
Sub GuardarMultiplesPDFBD() Application.ScreenUpdating = False Dim number_of_files As Integer ActiveSheet.HPageBreaks.Add Before:=ActiveCell ' number_of_files = ActiveSheet.HPageBreaks.Count carpeta = Cells(3, 16) fecha = Cells(7, 4) filename0 = carpeta For x = 1 To number_of_files row_pagebreak = ActiveSheet.HPageBreaks(x).Location.Row filename1 = ActiveSheet.Cells(row_pagebreak - 1, 2).Value & " " & fecha full_filename = filename0 & filename1 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ full_filename, Quality:= _ x1QualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ From:=x, To:=x, OpenAfterPublish:=False Next End Sub
1 Respuesta
H o l a:
Te anexo la macro.
Deberás cambiar en la macro lo siguiente:
Fila = 1 'número de fila donde empieza la impresión col = "D" 'columna final de impresión
También tienes que poner cuántas filas hay después del subtotal para el siguiente nombre de archivo en esta línea:
fila = b.Row + 1
Sub GuardarMultiplesPdf()
'Por.Dante Amor
fila = 1 'número de fila donde empieza la impresión
col = "D" 'columna final de impresión
carpeta = Cells(3, 16)
fecha = Cells(7, 4)
'
Set h = ActiveSheet
Set r = h.Columns("B")
Set b = r.Find("SUBTOTAL", LookAt:=xlPart, LookIn:=xlFormulas)
If Not b Is Nothing Then
celda = b.Address
Do
filename1 = h.Cells(fila, "B") & " " & fecha
h.PageSetup.PrintArea = "A" & fila & ":" & col & b.Row
h.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=carpeta & filename1 & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
fila = b.Row + 1
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
MsgBox "Fin"
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Buenas tardes.
Dante está excelente, hace justo lo que se quiere. Pero sabes que cuando llega a cierto punto se para y arroja error. Justo cuando llega casi a los ultimos reportes, específicamente cuando llega a un proveedor de apellido CONCHA. Como hago para anexarte el archivo con el cual estoy trabajando a ver si me ayudas a descubrir qué está pasando?
¿Qué error te pone?
¿En qué línea de la macro se detiene?
Tienes fórmulas en las celdas, alguna de las fórmulas tiene error del tipo "#", revisa que las celdas no tengan error, corrige los errores.
¿La fecha tiene diagonales? Entonces cambia esta línea
fecha = Cells(7, 4)
Por esta:
Fecha = format(Cells(7, 4), "dd-mm-yyyy")
El problema está en tus datos, no en la macro.
R ecuerda valorar la respuesta. 
Si todavía tienes problemas, entonces envíame toda la información:
¿Qué error te pone?
¿En qué línea de la macro se detiene?
Tienes fórmulas en las celdas, alguna de las fórmulas tiene error del tipo "#", revisa que las celdas no tengan error, corrige los errores.
¿La fecha tiene diagonales?
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “jezreelv” y el título de esta pregunta.
La celda de la fecha ya tenía el formato con guiones "-", porque ya sabía que al tener diagonales asume que es una dirección a una carpeta o archivo. La macro funciona, de hecho en esta ocasión son 391 reportes que debe generar en PDF, y guarda 365 y cuando va a guardar el siguiente (366) se detiene y arroja este error: "Se ha producido el error '-2147024773 (8007007b)' en tiempo de ejecución: El documento no se guardó". Y marca el error en estas lineas del guardado tipo PDF:
h.ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=carpeta & filename1 & ".pdf", Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Aunque todos los reportes tienen como parte de su nombre una fecha estática (31-05-2016) tendrá algo que ver con los 365 días del año? porque me causa curiosidad que se detiene justo cuando va a guardar el reporte numero 366.
Te voy a enviar el archivo al correo. Gracias de antemano. Al concluir el tema se valora la respuesta o se debe valorar cada una?
Listo ya lo envié.
En las filas 20367 el nombre tiene un carácter extraño, por eso no puede guardar el archivo.
Simplemente borra ese caracter y vuelve a ejecutar la macro.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Prueba con la siguiente macro para que te genere todos los archivos
Sub GuardarMultiplesPdf()
'Por.Dante Amor
on error resume next
fila = 1 'número de fila donde empieza la impresión
col = "D" 'columna final de impresión
carpeta = Cells(3, 16)
fecha = Cells(7, 4)
'
Set h = ActiveSheet
Set r = h.Columns("B")
Set b = r.Find("SUBTOTAL", LookAt:=xlPart, LookIn:=xlFormulas)
If Not b Is Nothing Then
celda = b.Address
Do
filename1 = h.Cells(fila, "B") & " " & fecha
h.PageSetup.PrintArea = "A" & fila & ":" & col & b.Row
h.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=carpeta & filename1 & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
fila = b.Row + 1
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
MsgBox "Fin"
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
