Trazar una linea en cada salto de pagina

hola Francisco,

no se a que se puede deber esto:=>>

, pero igual tambien traza adicionalmente la linea a

la mitad de la 3ra pagina (a lo ancho del rango de impresion) - Ya probe con
diferentes rangos de impresion - 5, 20 y 48 pag - y hace lo mismo.

en mis pruebas, aun con diferentes altos de fila funciona sin
problemas y solo marca debajo de la ultima fila de cada salto (lo de
la posicion de la ultima fila habra que mirarlo con mas calma, y
quizas con mas datos)

quizas tengas un rango de impresion preestablecido hasta la 3ª pag.??
o no se muy bien por que puede ser.

de todas formas prueba esta adaptacion para la hoja activa,

OJO, borra todos los bordes antes de poner los nuevos.

Sub SaltosDeLinea_3()
Dim f As Long, vista
Application.ScreenUpdating = False
With ActiveWindow
vista = .View: .View = xlPageBreakPreview
With ActiveSheet
f = 1
.UsedRange.Borders.LineStyle = xlLineStyleNone
.PageSetup.PrintArea = "a:j"
Do
.Range(.HPageBreaks(f).Location.Offset(-1), _
.HPageBreaks(f).Location.Offset(-1, 9)) _
.Borders(xlEdgeBottom).Weight = xlThick
f = f + 1
Loop Until f > .HPageBreaks.Count
End With
.View = vista
End With
End Sub


de todas formas hay algo que no acabo de coger en los saltos de linea,
asi que, aunque ahora parece funcionar bien y sin errores, no podria
asegurarlo al 100x100

si quieres, comentas como te ha ido, y en cuanto al resto, en cuanto
tenga un rato voy mirando ( y ya de paso si alguien mas se anima a
echar un cable pues bienvenido sea)

un saludo y hasta pronto
Ivan

Si, es muy curioso el efecto de la tercera pagina...pero no representaria
problema mayor... la borro y ya! Como quiera seguire probando..
Gracias otra vez..

Francisco

"Ivan" escribió:

hola Francisco,

no se a que se puede deber esto:=>>

>>, pero igual tambien traza adicionalmente la linea a
> la mitad de la 3ra pagina (a lo ancho del rango de impresion) - Ya probe con
> diferentes rangos de impresion - 5, 20 y 48 pag - y hace lo mismo.

en mis pruebas, aun con diferentes altos de fila funciona sin
problemas y solo marca debajo de la ultima fila de cada salto (lo de
la posicion de la ultima fila habra que mirarlo con mas calma, y
quizas con mas datos)

quizas tengas un rango de impresion preestablecido hasta la 3* pag.??
o no se muy bien por que puede ser.

de todas formas prueba esta adaptacion para la hoja activa,

OJO, borra todos los bordes antes de poner los nuevos.

Sub SaltosDeLinea_3()
Dim f As Long, vista
Application.ScreenUpdating = False
With ActiveWindow
vista = .View: .View = xlPageBreakPreview
With ActiveSheet
f = 1
.UsedRange.Borders.LineStyle = xlLineStyleNone
.PageSetup.PrintArea = "a:j"
Do
.Range(.HPageBreaks(f).Location.Offset(-1), _
.HPageBreaks(f).Location.Offset(-1, 9)) _
.Borders(xlEdgeBottom).Weight = xlThick
f = f + 1
Loop Until f > .HPageBreaks.Count
End With
.View = vista
End With
End Sub


de todas formas hay algo que no acabo de coger en los saltos de linea,
asi que, aunque ahora parece funcionar bien y sin errores, no podria
asegurarlo al 100x100

si quieres, comentas como te ha ido, y en cuanto al resto, en cuanto
tenga un rato voy mirando ( y ya de paso si alguien mas se anima a
echar un cable pues bienvenido sea)

un saludo y hasta pronto
Ivan

hola Francisco,

por si sigues por ahi te comento:

el ultimo codigo tampoco parece funcionar en el 100x100 de los casos, pues con alguna que otra combinacion de alto de
filas, trastoca la posicion de algunos de los bordes.

creo que se debe (y no me hagas demasiado caso, pues tan solo es una impresion) a que los saltos de pagina se fijan en
el momento de activar la vista previa, y una vez activada esta, si se modifican las alturas de fila, gruesos de linea,
etc, aunque vuelvas a hacer mencion al salto de pagina correspondiente para redimensionarlo, este permanece en los
parametros que habia al iniciarse la vista previa, o sea no se actualiza, aunque si se alteran los rangos a los que hace
referencia para que quepan en cada pagina.

creo que para detectar los nuevos rangos a los que hace referencia los nuevos saltos de pagina tras la modificacion, hay
que volver a la vista normal y volver a la vista previa.

en este caso seria con cada salto de pagina.

bueno, no se si se ha entendido lo que quiero decir, ni si tengo algo de razon, pero este nuevo codigo parece que
funciona mejor,

ademas respeta los posibles formatos de bordes que tuvieras asignados. Es un tanto enrevesado y posiblemente le sobren
muchas cosas, pero de momento, y dado que ya parece funcionar, no me atrevo a descargarlo.

para 2100 registros (de 50 a 60 saltos de pagina) tarda entre 13 y 20 segundos

en cuanto a ajustar el alto de la pagina para que visualmente quede la linea final de hoja (+/-) a la misma altura,
estoy haciendo unas pruebas que si dan resultados te comento.

Sub SaltosDePagina()
Dim f As Long, nHp As Integer, ufT As Long, ufP As Long, _
rngIni As Range, rngPreSalto As Range, vista, bordeI, bordeLS
Application.ScreenUpdating = False
With ActiveSheet: ufT = .[a65536].End(xlUp).Row
If ufT < 2 Or Cells(ufT - 1, 1) = "" Then Exit Sub
With .PageSetup: .Orientation = xlLandscape: .PrintArea = "a:j": End With
With ActiveWindow: vista = .View: .View = xlNormalView
.View = xlPageBreakPreview: End With
If .HPageBreaks.Count < 1 Then
.Range("a" & ufT & ":j" & ufT).Borders(xlEdgeBottom) = xlMedium
nHp = .HPageBreaks.Count
If nHp > 0 Then .Range("a" & ufT - 1 & ":j" & ufT - 1) _
.Borders(xlEdgeBottom) = xlMedium
ActiveWindow.View = vista: Exit Sub
Else
ActiveWindow.View = xlNormalView
Set rngIni = .Range("a" & ufT).End(xlUp).Offset(2)
With rngIni.Borders(xlEdgeBottom)
bordeLS = .LineStyle
If bordeLS = xlLineStyleNone Then bordeI = "" Else bordeI = .Weight
End With
With .Range("a" & rngIni.Row - 1 & ":j" & ufT).Borders(xlInsideHorizontal)
.LineStyle = xlLineStyleNone: .LineStyle = bordeLS
If bordeI <> "" Then .Weight = bordeI
End With
f = 1
Do
rngIni.Borders(xlEdgeBottom).Weight = xlMedium
ActiveWindow.View = xlPageBreakPreview
Set rngPreSalto = .Range(.HPageBreaks(f).Location.Offset(-1), _
.HPageBreaks(f).Location.Offset(-1, 9))
rngPreSalto.Borders(xlEdgeBottom).Weight = xlMedium
rngIni.Borders(xlEdgeBottom).LineStyle = bordeLS
If bordeI <> "" Then rngIni.Borders(xlEdgeBottom).Weight = bordeI Else _
rngIni.Borders(xlEdgeBottom).Weight = 2
If rngPreSalto.Cells(1).Offset(1, 0).Value = "" Then Exit Do
ActiveWindow.View = xlNormalView
Set rngIni = rngPreSalto.Offset(2, 0)
rngIni.Borders(xlEdgeBottom).Weight = xlMedium
ActiveWindow.View = xlPageBreakPreview
If .HPageBreaks.Count = f Then Exit Do
f = f + 1
Loop Until f > .HPageBreaks.Count
ActiveWindow.View = vista
With rngIni.Borders(xlEdgeBottom)
.LineStyle = bordeLS
If bordeI <> "" Then .Weight = bordeI
End With
Set rngIni = Nothing: Set rngPreSalto = Nothing
End If
End With
End Sub

no se si puede tener todavia algun escape, la he probado con bastantes opciones de configuracion de pagina, altos de
fila variados, etc y parece ir bien, pero...

espero te sirva y si alguien ve alguna otra opcion para manejar los saltos de pagina ( que seguro que la hay, y mucho
mas sencilla), sera bienvenido su consejo

un saludo y hasta pronto
Ivan

he vuelto a meter la pata y me he equivocado de macro al enviarla,

esta es la que creo que es la ¿buena? (casi igual, pero con un ligero matiz ..)

Sub Saltos_De_Pagina()
Dim f As Long, nHp As Integer, ufT As Long, ufP As Long, _
rngIni As Range, rngPreSalto As Range, vista, bordeI, bordeLS
Application.ScreenUpdating = False
With ActiveSheet: ufT = .[a65536].End(xlUp).Row
If ufT < 2 Or Cells(ufT - 1, 1) = "" Then Exit Sub
With .PageSetup: .Orientation = xlLandscape: .PrintArea = "a:j": End With
With ActiveWindow: vista = .View: .View = xlNormalView
.View = xlPageBreakPreview: End With
If .HPageBreaks.Count < 1 Then
.Range("a" & ufT & ":j" & ufT).Borders(xlEdgeBottom) = xlMedium
nHp = .HPageBreaks.Count
If nHp > 0 Then .Range("a" & ufT - 1 & ":j" & ufT - 1) _
.Borders(xlEdgeBottom) = xlMedium
ActiveWindow.View = vista: Exit Sub
Else
ActiveWindow.View = xlNormalView
Set rngIni = .Range("a" & ufT).End(xlUp).Offset(2)
With rngIni.Borders(xlEdgeBottom)
bordeLS = .LineStyle
If bordeLS = xlLineStyleNone Then bordeI = "" Else bordeI = .Weight
End With
With .Range("a" & rngIni.Row - 1 & ":j" & ufT).Borders(xlInsideHorizontal)
.LineStyle = xlLineStyleNone: .LineStyle = bordeLS
If bordeI <> "" Then .Weight = bordeI
End With
f = 1
Do
rngIni.Borders(xlEdgeBottom).Weight = xlMedium
ActiveWindow.View = xlPageBreakPreview
Set rngPreSalto = .Range(.HPageBreaks(f).Location.Offset(-1), _
.HPageBreaks(f).Location.Offset(-1, 9))
rngPreSalto.Borders(xlEdgeBottom).Weight = xlMedium
With rngIni.Borders(xlEdgeBottom)
.LineStyle = xlLineStyleNone: .LineStyle = bordeLS
If bordeI <> "" Then .Weight = bordeI
End With
If rngPreSalto.Cells(1).Offset(1, 0).Value = "" Then Exit Do
ActiveWindow.View = xlNormalView
Set rngIni = rngPreSalto.Offset(2, 0)
rngIni.Borders(xlEdgeBottom).Weight = xlMedium
ActiveWindow.View = xlPageBreakPreview
If .HPageBreaks.Count = f Then Exit Do
f = f + 1
Loop Until f > .HPageBreaks.Count
ActiveWindow.View = vista
With rngIni.Borders(xlEdgeBottom)
.LineStyle = bordeLS
If bordeI <> "" Then .Weight = bordeI
End With
Set rngIni = Nothing: Set rngPreSalto = Nothing
End If
End With
End Sub

disculpa, pero por si acbas probandola

un saludo
Ivan

hola de nuevo,

aunque seguro que Francisco anda ya en otros berengenales, como me habia quedado la espinita y el tema seguia (y
seguira) con bastantes flecos, y por si en alguna busqueda futura, alguien llega al hilo y le pudiera interesar, aqui
pongo el resultado de mis pesquisas:

el siguiente grupo de codigos pone un borde al final de cada salto de pagina y lo 'coloca' igual para todos (en el
maximo alto de pag. permitido segun la configuracion de la hoja)

estan hechos para una lista de la columna A a la J, aunque creo que no reeeesulta dificil adaptarlos, y en teoria da lo
mismo que se repitan filas/ titulos en la parte superior,

aunque con muy variadas combinaciones de altos de filas, parece trabajar bien, seguramente habra mas de una combinacion
en la que no lo haga (pej. seguramente si hay varias filas seguidas con muy pocas filas y nuy altas)

OJO: aunque la linea/borde inferior de los saltos de pag. queda bien visualmente y salvo alguna excepcion que pudiera
surgir, totalmente igualadas, la estetica visual de los registros puede que no sea asi, pues el alto que faltaria en
cada pag. se va ajustando desde arriba celda a celda en intervalos de 0,75 puntos y dependiendo de las diferencias entre
filas de cada pag, pueden surgir algunos efectos visuales no del todo uniformes

bueno, aqui van los codigos, seguramente muy simplificables y con mas de una reiteracion y posiblemente con algo de
chatarra, pero los he ido haciendo a ratos y quizas esten un tanto deslabazados.

ya que estan, por si a alguien le pudieran valer

un saludo
Ivan

' para la ejecucion solo habria que poner el nombre de la hoja en el ultimo procedimiento y llamarlo de la manera que
nos parezca mejor

' copiar desde aquien un modulo normal
'
'
' Ajusta el alto del rango pasado (rngPag) al alto pasado en el argumento
' altoAjustar (este debe ser igual al alto maximo de salto de pagina menos:
' a) para la primera pagina el alto del rango que va desde la fila 1 hasta
' la de titulos, incluida. b) Para el resto el alto de las filas elegidas
' en repetir filas de 'Configurar pagina' o 0 si no se repiten filas).
' Y pone un borde continuo a la ultima fila de cada pagina del grosor
' pasado en grosorBorde (xlHairLine, xlThin, xlMedium o xlThick)
'
Sub AjustarPagConBordeInf(ByRef rngPag As Range, _
ByVal altoAjustar As Single, _
ByVal grosorBorde As Variant)
Dim plusBorde As Single, alto As Single, altoCelda As Single, _
difAlto As Single, resto As Single, Celda As Range
Select Case grosorBorde
Case xlMedium, xlThick: plusBorde = 0.75
Case Else: plusBorde = 0
End Select
With rngPag
alto = .Height
Select Case alto
Case Is > altoAjustar
MsgBox "El alto de ajuste excede lo permitido": Exit Sub
Case Is = altoAjustar
.Rows(.Rows.Count).RowHeight = .Rows(.Rows.Count).Height - plusBorde
Case Else
difAlto = altoAjustar - alto
Do
For Each Celda In .Parent.Range(.Columns(1).Address)
With Celda
altoCelda = .Height
If difAlto < plusBorde Then
.RowHeight = altoCelda - 0.75
Exit For
ElseIf difAlto = plusBorde Then
Exit For
ElseIf altoCelda > 408.25 Then
Else
.RowHeight = altoCelda + 0.75: difAlto = difAlto - 0.75
End If
End With
Next
Loop Until difAlto <= plusBorde
End Select
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous: .Weight = grosorBorde
End With
End With
End Sub
'
' Devuelve el alto maximo de salto de pagina de la hoja pasada (hj)
' en funcion de los ajustes de configuracion, fuente, etc
' Para ello crea y elimina una hoja identica al original
'
Function Max_Alto_Pag(ByRef hj As Worksheet) As Single
Dim ultf As Long, n As Integer, max As Single, rng As Range
Application.ScreenUpdating = False
With hj: .Copy .Parent.Worksheets(.Name): End With
With ActiveSheet
.Rows.RowHeight = .StandardHeight
.[a1:a2000].Value = "A"
ActiveWindow.View = xlPageBreakPreview
ultf = .HPageBreaks(1).Location.Row - 1
max = .Range("a1:a" & ultf).Height
Set rng = .Range("a" & ultf)
For n = 0 To .StandardHeight Step 0.75
ActiveWindow.View = xlNormalView
rng.RowHeight = rng.Height + n
ActiveWindow.View = xlPageBreakPreview
ultf = .HPageBreaks(1).Location.Row - 1
If .Range("a1:a" & ultf).Height < max Then _
rng.RowHeight = rng.Height - 0.75: Exit For
Next
Max_Alto_Pag = .Range(.[a1], rng).Height
Set rng = Nothing
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
End Function
'
' pone los bordes pasados y del estilo y grosor especificados
' al rango pasado(rng)
'
Sub Poner_Borde(ByRef rng As Range, _
Optional ByVal borde As Variant = xlInsideHorizontal, _
Optional ByVal Estilo_Borde As Variant = xlLineStyleNone, _
Optional ByVal Grueso_Borde As Variant = xlThin)
With rng.Borders(borde)
.LineStyle = Estilo_Borde
If Estilo_Borde <> xlLineStyleNone Then .Weight = Grueso_Borde
End With
End Sub
'
' Devuelve, para la hoja pasada (hj_Datos) el nº de la 1ª fila con
' datos de la lista (se supone que al menos tiene una fila de titulos
' y que esta no tiene datos en la fila inmediatamente superior).
' tambien devuelve la altura desde la 1ª fila hasta la de titulos
' incluida en (Alto_Inicio) y la de las filas repetidas, si las hay,
' en Alto_repetidas. Estas son para restarselas al alto maximo de pag.
'
Function PrimeraFilaDatos(ByRef hj_Datos As Worksheet, _
ByRef Alto_Inicio As Single, _
ByRef Alto_Repetidas As Single) As Integer
Dim FilasRepetidas As String
With hj_Datos
FilasRepetidas = .PageSetup.PrintTitleRows
If FilasRepetidas <> "" Then
With .Range(FilasRepetidas)
Alto_Repetidas = .Height
PrimeraFilaDatos = .Cells(1).Row + .Rows.Count
End With
Else
Alto_Repetidas = 0
PrimeraFilaDatos = .[a65536].End(xlUp).End(xlUp).Row + 1
End If
Alto_Inicio = .Range("a1:a" & PrimeraFilaDatos - 1).Height
End With
End Function
'
' Devuelve la referencia del rango de la hoja pasada (hj_Salto)
' correspondiente al salto de pagina pasado en nro_Salto.
' opcionamente tambiende vuelve el nº total de saltos de
' la hoja (nSaltos) y/o el nº de la ultima fila (ultFilaPag)
' del salto de pag. correspondiente a nro_Sallto
'
Function RefPagina(ByRef hj_Salto As Worksheet, _
ByVal nro_Salto As Integer, _
Optional ByRef nSaltos As Integer = 0, _
Optional ByRef ultFilaPag As Long = 0) As String
Dim pFila As Long, VistaHj
Application.ScreenUpdating = False
With ActiveWindow
VistaHj = .View: .View = xlNormalView: .View = xlPageBreakPreview
With hj_Salto
nSaltos = .HPageBreaks.Count
If nSaltos < 1 Or nro_Salto > nSaltos Then Exit Function
If nro_Salto > 1 Then pFila = .HPageBreaks(nro_Salto - 1).Location.Row Else pFila = 1
ultFilaPag = .HPageBreaks(nro_Salto).Location.Row - 1
End With
.View = VistaHj
End With
RefPagina = "a" & pFila & ":a" & ultFilaPag
End Function
'
' junta todo lo anterior y pone el borde ajustado a la altura maxima de
' cada salto de pagina
'
Sub Ajustar_Borde_Areas(ByRef hj_Ajuste As Worksheet)
Dim refPag As String, fUlt As Long, fIniDatos As Integer, _
fUltPag As Long, hInicial As Single, hFilasRepes As Single, _
hMaximoPag As Single, hRangoPag As Single, TotalSaltos As Integer, _
rngPag As Range, n As Integer, vistaInicial
vistaInicial = ActiveWindow.View
With hj_Ajuste
fUlt = .[a65536].End(xlUp).Row
If fUlt = 1 Then MsgBox "No hay datos en la lista": Exit Sub
Application.ScreenUpdating = False
fIniDatos = PrimeraFilaDatos(hj_Ajuste, hInicial, hFilasRepes)
If fUlt < fIniDatos Then MsgBox "No hay datos en la lista": Exit Sub
With .Range("a" & fIniDatos).Borders(xlEdgeBottom)
Poner_Borde hj_Ajuste.Range("a" & fIniDatos & ":j" & fUlt), , .LineStyle, .Weight
End With
refPag = RefPagina(hj_Ajuste, 1, TotalSaltos, fUltPag)
If refPag = "" Then MsgBox "No hay saltos de pagina": _
ActiveWindow.View = vistaInicial: Exit Sub
hMaximoPag = Max_Alto_Pag(hj_Ajuste)
Set rngPag = .Range("a" & fIniDatos & ":j" & fUltPag)
AjustarPagConBordeInf rngPag, hMaximoPag - hInicial, xlMedium
n = 2
refPag = RefPagina(hj_Ajuste, n, , fUltPag)
Do While refPag <> ""
Set rngPag = .Range(.Range(refPag).Cells(1), .Range("j" & fUltPag))
AjustarPagConBordeInf rngPag, hMaximoPag - hFilasRepes, xlMedium
n = n + 1
refPag = RefPagina(hj_Ajuste, n, , fUltPag)
Loop
End With
Set rngPag = Nothing
ActiveWindow.View = vistaInicial
End Sub
'
' para llamar a la macro
'
Sub test_Ajustar_Borde_Areas()
Ajustar_Borde_Areas Worksheets("Hoja1")
End Sub