Macro que imprima en tamaño media carta un encabezado un contenido definido y un pie de página
Elsita como estas.
Tengo la siguiente solicitud. Tengo una hoja llamada "Registro" en la cual registro varios items. Los registros están contenidos de la columna "B" a la columna "O" y ocupan 4 filas empezando desde la fila 17. Es decir que el primer registro va desde la fila 17 hasta la fila 20, el segundo registro desde la fila 21 hasta la fila 24 y el tercer registro desde la fila 25 hasta la fila 28 y así sucesivamente. Cuando la próxima secuencia esté vacía, es por que ya no hay más registros.
Tengo una hoja llamada "Encypie" que lo que significa es encabezado y pie de página. Como su nombre lo dice, allí tengo diseñado como es el encabezado y pie de página que deseo.
El encabezado esta de la columna "A" a la columna "N" y de la fila 1 a la fila 10.
El pie de página está de la columna "A" a la columna "N" y de la fila 21 a la fila 24.
Lo que quisiera es que me ayudaras con una macro que hiciera lo siguiente.
Entonces en resumen hasta este momento, tengo los registros, tengo el encabezado que deseo poner antes de cada cierta cantidad de registros y tengo el pie de página que deseo poner cada cierta cantidad de registros.
La macro que deseo que me ayudes a generar es la siguiente:
En la fila 17 debe insertar 10 filas, al hacer eso, entonces está desplazando el primer registro 10 filas más abajo, eso con el fin de copiar en la fila 17 de la columna "B" el encabezado. Este proceso se repetirá es decir colocar un nuevo encabezado cada 3 registros hacia abajo. Es decir, la macro lo que debe hacer es los siguiente:
Ir a la fila 17, insertar 10 filas, copiar a partir de la columna "B" y fila 17 el encabezado,
Luego dirigirse al final del tercer registro (es decir 12 filas más abajo) allí insertar en la columna "B" y fila 40 lo correspondiente a 4 filas para colocar allí el pie de página, la macro debe revisar si hay más registros (Celdas ocupadas) después del pie de página, si es así entonces de donde termina el pie de página inserta nuevamente 10 filas y coloca otra vez el encabezado y repite el mismo procedimiento descrito anteriormente:
2 Respuestas
H o l a:
Te anexo la macro para generar el pdf
Sub GenerarPdf()
'Por.Dante Amor
Set h1 = Sheets("Registro")
Set h2 = Sheets("diseño para Pdf")
Set h3 = Sheets("salida a pdf")
'
h3.Cells.ClearContents
h3.DrawingObjects.Delete
'
n = 0
j = 1
h2.Rows("1:25").Copy h3.Range("A" & j)
j = j + 25
m = 11
For i = 17 To h1.Range("B" & Rows.Count).End(xlUp).Row
If Left(h1.Cells(i, "B"), 1) = "#" Then
h3.Cells(m, "A") = h1.Cells(i, "B")
h3.Cells(m, "B") = h1.Cells(i, "C")
h3.Cells(m, "J") = h1.Cells(i, "I")
h3.Cells(m, "L") = h1.Cells(i, "J")
h3.Cells(m, "M") = h1.Cells(i, "K")
h3.Cells(m + 1, "A") = h1.Cells(i + 1, "B")
h3.Cells(m + 1, "B") = h1.Cells(i + 1, "D")
m = m + 4
n = n + 1
If n = 3 Then
h2.Rows("1:25").Copy h3.Range("A" & j)
j = j + 25
m = m + 13
End If
End If
Next
'
ConfigurarPagina h3
h3.ResetAllPageBreaks
For i = 26 To h3.UsedRange.Rows.Count Step 25
h3.HPageBreaks.Add Before:=h3.Cells(i, "A")
Next
'
ruta = ThisWorkbook.Path & "\"
h3.ExportAsFixedFormat xlTypePDF, _
ruta & "archivo.pdf", xlQualityStandard, True, False, , , False
'
MsgBox "Pdf generado", vbInformation, "PDF"
End Sub
Sub ConfigurarPagina(h3)
With h3.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
h3.PageSetup.PrintArea = ""
With h3.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.393700787401575)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.748031496062992)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
End SubS a l u d o s
¡Gracias!
Super Excelente Dante muchas Gracias.
Sol hay un arreglito adicional que necesito que me ayudes pero te la hago en otra pregunta como siempre hemos acordado, se trata de que el archivo de salida de PDF salga con un nombre predeterminado.
Nuevamente Gracias.
