O link do microsoft "HPageBreaks Collection"
A grosso modo:
"quebra de paginas Horizontais" (existem tambem as verticais); Automaticamente o excel cria essas "quebras", somente para area de impressão.
É possivel incluir quebras (num limite de 1026) mesmo fora da area de impressão, contudo estando fora da area de impressão não serão "consideradas" na Coleção de quebra de paginas.
Link do Ozgrid o codigo criado por Hans Pottel: (Já foi mencionado se não me engano, em outro post sobre a impressão de 50 em 50 linhas)
Obs.: Se já houver quebras de pagina no arquivo/area de impressão, serão acrescentadas novas e não substituidas as existentes.
Sub PrintAreaWithpageBreaks()
Dim pages As Integer 'Declaração da variavel pagina
Dim pageBegin As String 'Declaração da variavel inicio de pagina
Dim PrArea As String ' Declaração da area de impressão
Dim i As Integer
Dim q As Integer
Dim nRows As Integer, nPagebreaks As Integer
Dim R As Range
Set R = ActiveSheet.UsedRange ' Define range utilizada
'add pagebreak every 40 rows - Cria uma quebra de pagina a cada 40 linhas
nRows = R.Rows.Count ' Calcula quantas linhas tem a range utilizada
If nRows > 40 Then 'Somente se houver mais de 40 linhas adicina uma quebra
nPagebreaks = Int(nRows / 40)
For i = 1 To nPagebreaks '
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=R.Cells(40 * i + 1, 1)
Next i
End If
'can be used in a separate macro, as I Start counting the number of pagebreaks
'Pode ser em uma macro separada, Começo contando o numero de quebras de paginas
pages = ActiveSheet.HPageBreaks.Count
pageBegin = "$A$1" 'Considera A1 como inicial
For i = 1 To pages
If i > 1 Then pageBegin = ActiveSheet.HPageBreaks(i - 1).Location.Address
q = ActiveSheet.HPageBreaks(i).Location.Row - 1
PrArea = pageBegin & ":" & "$H$" & Trim$(Str$(q)) 'Determina Range de impressão de cada pagina Aqui vai até coluna H
ActiveSheet.PageSetup.PrintArea = PrArea
' the cell in column 1 and in the row immediately below the pagebreak - A celula na coluna 1 na linha logo abaixo da quebra
' contains text for the footer - Contem o texto para o rodape de impressão
ActiveSheet.PageSetup.CenterFooter = Cells(q, 1)
' ActiveSheet.PrintOut copies:=1
Next i
End Sub
Aqui um codigo do Alexel (ExcleBr - Yahoogroups) Verifica quantas quebras onde e de que tipo.
Sub fnTestHPageBreaks()
Dim objHPgBk As Excel.HPageBreak
Dim colHPgBk As Excel.HPageBreaks
Set colHPgBk = ActiveSheet.HPageBreaks
If Not colHPgBk Is Nothing Then
MsgBox "Total de quebras horizontais úteis: " & colHPgBk.Count
For Each objHPgBk In colHPgBk
MsgBox "Existe uma quebra entre as linhas " & objHPgBk.Location.Row - 1 & " e " & objHPgBk.Location.Row & vbNewLine & _
"Tipo desta quebra: " & IIf(objHPgBk.Type = xlPageBreakAutomatic, "Automática", IIf(objHPgBk.Type = xlPageBreakManual, "Manual", "Nenhuma"))
Next
End If
End Sub
Postado : 06/05/2012 3:24 pm