martes, 23 de octubre de 2018

VBA: Páginas de impresión Excel

Al hilo de una duda planteada a través del email, donde se preguntaba por la forma de añadir un pie de página o encabezado diferenciado en una página intermedia de impresión, busqué alternativas con el estándar de la hoja de cálculo... sin éxito.
Por lo que opté por desarrollar un proceso donde identificar los rangos contenidos en cada página de impresión... para a continuación ir imprimiéndoles de manera individual y así poder personalizar el encabezado (o pie de página) de la hoja deseada...


la macro es laboriosa por que debemos identificar, basándonos en los saltos de página verticales y horizontales, cada rango de cada página, para luego definir su alto y ancho y terminar redefiniendo el área de impresión y su configuración de página.

Insertamos el siguiente procedimiento 'Sub' en un módulo estándar:

Sub PaginasImpresion()
'www.excelforo.com
'macro destinada para añadir un encabezado o pié de página diferenciado
'en una página intermedia (que no sea la primera)...

'determinamos número de saltos horizontales y verticales
Dim SaltosH As Long, SaltosV As Long
SaltosH = ActiveSheet.HPageBreaks.Count
SaltosV = ActiveSheet.VPageBreaks.Count

'obtenemos el área de impresión
Dim AreaImp As String
AreaImp = ActiveSheet.PageSetup.PrintArea

'número inicial de fila y de columna
'y número final de fila y columna del área de impresión
Dim filaIni As Long, colIni As Long, filaFin As Long, colFin As Long
filaIni = ActiveSheet.Range(AreaImp).Row
colIni = ActiveSheet.Range(AreaImp).Column
filaFin = filaIni + ActiveSheet.Range(AreaImp).Rows.Count
colFin = colIni + ActiveSheet.Range(AreaImp).Columns.Count

'forzamos el sentido de impresión
ActiveSheet.PageSetup.Order = xlOverThenDown 'hacia derecha y luego hacia abajo

'determinamos las columnas de los saltos verticales
Dim arrVertical()
ReDim Preserve arrVertical(0)
arrVertical(0) = colIni
vv = 1
For v = 1 To SaltosV
    salto = ActiveSheet.VPageBreaks(v).Location.Column
    If salto >= colIni And salto <= colFin Then
        ReDim Preserve arrVertical(vv)
        arrVertical(vv) = salto
        vv = vv + 1
    End If
Next v
ReDim Preserve arrVertical(vv)
arrVertical(vv) = colFin

'calculamos ancho de páginas
Dim arrAncho()
a = 1
For x = 1 To vv
    ReDim Preserve arrAncho(a)
    arrAncho(a) = arrVertical(x) - arrVertical(x - 1)
    a = a + 1
Next x

'determinamos las filas de los saltos horizontales
Dim arrHorizontal()
ReDim Preserve arrHorizontal(0)
arrHorizontal(0) = filaIni
hh = 1
For h = 1 To SaltosH
    salto = ActiveSheet.HPageBreaks(h).Location.Row
    If salto >= filaIni And salto <= filaFin Then
        ReDim Preserve arrHorizontal(hh)
        arrHorizontal(hh) = salto
        hh = hh + 1
    End If
Next h
ReDim Preserve arrHorizontal(hh)
arrHorizontal(hh) = filaFin

'calculamos alto de páginas
Dim arrAlto()
a = 1
For x = 1 To hh
    ReDim Preserve arrAlto(a)
    arrAlto(a) = arrHorizontal(x) - arrHorizontal(x - 1)
    a = a + 1
Next x

'calculamos el número de páginas a imprimir
Dim NumPags As Long
NumPags = hh * vv

Dim arrPaginas()
'generamos el área de cada página
pp = 1
'recorremos primera las cols y luego las filas
'de acuerdo al orden de impresión marcado al inicio de la macro
For filas = 0 To hh - 1
    For cols = 0 To vv - 1
        rngArea = Range(Cells(arrHorizontal(filas), arrVertical(cols)), _
            Cells(arrHorizontal(filas), arrVertical(cols)).Offset(arrAlto(filas + 1) - 1, arrAncho(cols + 1) - 1)).Address
        ReDim Preserve arrPaginas(pp)
        arrPaginas(pp) = rngArea
        pp = pp + 1
    Next cols
Next filas


'Terminamos imprimiendo página a página
'para añadir solo el pié de página a la hoja que queramos... por ejemplo a la segunda página
For impresion = 1 To NumPags
    ActiveSheet.PageSetup.PrintArea = arrPaginas(impresion)
    If impresion = 2 Then
        With ActiveSheet.PageSetup
            .CenterHeader = "página 2 personalizada"
        End With
        ActiveSheet.PrintPreview
        'en su caso imprimimos
        'ActiveSheet.Printout
    Else
        With ActiveSheet.PageSetup
            .CenterHeader = ""
        End With
        ActiveSheet.PrintPreview
        'en su caso imprimimos
        'ActiveSheet.Printout
    End If
Next impresion

'terminamos dejando el área de impresión inicial
ActiveSheet.PageSetup.PrintArea=AreaImp
End Sub

Podemos lanzar la macro sobre un rango como el de la imagen:

VBA: Páginas de impresión Excel

En el ejemplo vemos nuestra área de impresión (B3:H27) dividida en cuatro páginas que hemos ordenado su impresión 'hacia la derecha y luego hacia abajo': Página 1: área B3:E12 Página 2: área F3:H12 Página 3: área B13:E27 Página 4: área F13:E27 lanzando el proceso podremos comprobar como solo la página dos aparece con el encabezado diferenciado...

VBA: Páginas de impresión Excel

Sin duda se pueden sacar más ventajas de lo desarrollado...

No hay comentarios:

Publicar un comentario

Nota: solo los miembros de este blog pueden publicar comentarios.