L
Lars Kofod
Sorry, but I just don't understand what happens when I
use HPageBreak(s).
I have a worksheet with 335 rows (could be any number),
and I need a presentable output to paper. I check where
the horizontal pagebreaks are, check for a few things,
and then decide whether to leave or move the pagebreak.
A present my sub reports 5 pagebreaks, locatede at rows
66,132,198,265 and 331. After checking and deciding the
1. break is at 65, and the second at 127 and then my sub
end with RT error 9. Earlier today it worked fine.
With the same sheet it has reported everything from 0 to
5 pagebreaks.
Someone please help
Lars Kofod
Here's the code:
Sub CheckSideSkift()
Dim iPBRaekke, lRaekkeNr As Long
Dim sStartCelle, sUdskriftsOmraade As String
StartTid = Time
'Application.ScreenUpdating = False
FjernSideSkift
sStartCelle = ActiveCell.Address
'Cells.PageBreak = xlpagebreaknone
'Finder sidste række i kalkulation
Range("d65536").Select
Selection.End(xlUp).Select
lRaekkeNr = Selection.Row
'Laver udskriftsområde
sUdskriftsOmraade = "A2:" & "J" & lRaekkeNr
ActiveSheet.PageSetup.PrintArea = sUdskriftsOmraade
'Løber alle rækker i regnearket igennem
'For x = 17 To lRaekkeNr
ActiveWindow.View = xlPageBreakPreview
ActiveWindow.View = xlNormalView
x = ActiveSheet.HPageBreaks.Count
MsgBox x
For Each pb In ActiveSheet.HPageBreaks
iPBRaekke = pb.Location.Row
MsgBox iPBRaekke
Next
For Each pb In ActiveSheet.HPageBreaks
'Cells(iPBRaekke, 2).Select
'(0) Checker for automatisk sideskift
'If Rows(iPBRaekke).PageBreak = xlPageBreakAutomatic
Then
'Cells(iPBRaekke, 3).Select
'-------------------------------------------------
-----
'(1) Checker om rækken indeholder overskrift i
kolonne 1
iPBRaekke = pb.Location.Row 'STOPS HERE RT Error 9
MsgBox iPBRaekke
If Cells(iPBRaekke, 1).Font.Bold = True Then
GoTo SlutCheck
End If '(1)
'-------------------------------------------------
-----
'(2) Checker om rækken eller rækken over
indeholder overskrift
If Cells(iPBRaekke, 2).Font.Bold = True Then
If Cells(iPBRaekke - 1, 1).Font.Bold = True
Then
Rows(iPBRaekke - 1).PageBreak =
xlPageBreakManual
GoTo SlutCheck
End If
End If '(2)
'-------------------------------------------------
-----
'(3) Checker om rækken over eller rækken 2 over
indeholder overskrift
If Cells(iPBRaekke - 1, 2).Font.Bold = True Then
If Cells(iPBRaekke - 2, 1).Font.Bold = True
Then
Rows(iPBRaekke - 2).PageBreak =
xlPageBreakManual
GoTo SlutCheck
Else
Rows(iPBRaekke - 1).PageBreak =
xlPageBreakManual
GoTo SlutCheck
End If
End If '(3)
'-------------------------------------------------
-----
'(4) Checker om rækken 2 over eller rækken 3 over
indeholder overskrift
If Cells(iPBRaekke - 2, 2).Font.Bold = True Then
If Cells(iPBRaekke - 3, 1).Font.Bold = True
Then
Rows(iPBRaekke - 3).PageBreak =
xlPageBreakManual
GoTo SlutCheck
Else
Rows(iPBRaekke - 2).PageBreak =
xlPageBreakManual
GoTo SlutCheck
End If
End If '(4)
'-------------------------------------------------
-----
'(5) Checker om der er 2 eller flere linier på
næste side
If Cells(iPBRaekke, 3).Value = 0 Then
GoTo SlutCheck
Else
If Cells(iPBRaekke + 1, 3).Value = 0 Then
Cells(iPBRaekke, 2).Select
Selection.End(xlUp).Select
If Selection.Offset(-1, -1).Font.Bold =
True Then
Rows(Selection.Offset(-1, -
1).Row).PageBreak = xlPageBreakManual
Else
Rows(Selection.Row).PageBreak =
xlPageBreakManual
End If
End If
End If '(5)
'End If '(0)
iPBRaekke = pb.Location.Row
MsgBox iPBRaekke
SlutCheck:
Next
Range(sStartCelle).Select
Application.ScreenUpdating = True
SlutTid = Time
tid = (SlutTid - StartTid) * 24 * 3600
'MsgBox tid
End Sub
use HPageBreak(s).
I have a worksheet with 335 rows (could be any number),
and I need a presentable output to paper. I check where
the horizontal pagebreaks are, check for a few things,
and then decide whether to leave or move the pagebreak.
A present my sub reports 5 pagebreaks, locatede at rows
66,132,198,265 and 331. After checking and deciding the
1. break is at 65, and the second at 127 and then my sub
end with RT error 9. Earlier today it worked fine.
With the same sheet it has reported everything from 0 to
5 pagebreaks.
Someone please help
Lars Kofod
Here's the code:
Sub CheckSideSkift()
Dim iPBRaekke, lRaekkeNr As Long
Dim sStartCelle, sUdskriftsOmraade As String
StartTid = Time
'Application.ScreenUpdating = False
FjernSideSkift
sStartCelle = ActiveCell.Address
'Cells.PageBreak = xlpagebreaknone
'Finder sidste række i kalkulation
Range("d65536").Select
Selection.End(xlUp).Select
lRaekkeNr = Selection.Row
'Laver udskriftsområde
sUdskriftsOmraade = "A2:" & "J" & lRaekkeNr
ActiveSheet.PageSetup.PrintArea = sUdskriftsOmraade
'Løber alle rækker i regnearket igennem
'For x = 17 To lRaekkeNr
ActiveWindow.View = xlPageBreakPreview
ActiveWindow.View = xlNormalView
x = ActiveSheet.HPageBreaks.Count
MsgBox x
For Each pb In ActiveSheet.HPageBreaks
iPBRaekke = pb.Location.Row
MsgBox iPBRaekke
Next
For Each pb In ActiveSheet.HPageBreaks
'Cells(iPBRaekke, 2).Select
'(0) Checker for automatisk sideskift
'If Rows(iPBRaekke).PageBreak = xlPageBreakAutomatic
Then
'Cells(iPBRaekke, 3).Select
'-------------------------------------------------
-----
'(1) Checker om rækken indeholder overskrift i
kolonne 1
iPBRaekke = pb.Location.Row 'STOPS HERE RT Error 9
MsgBox iPBRaekke
If Cells(iPBRaekke, 1).Font.Bold = True Then
GoTo SlutCheck
End If '(1)
'-------------------------------------------------
-----
'(2) Checker om rækken eller rækken over
indeholder overskrift
If Cells(iPBRaekke, 2).Font.Bold = True Then
If Cells(iPBRaekke - 1, 1).Font.Bold = True
Then
Rows(iPBRaekke - 1).PageBreak =
xlPageBreakManual
GoTo SlutCheck
End If
End If '(2)
'-------------------------------------------------
-----
'(3) Checker om rækken over eller rækken 2 over
indeholder overskrift
If Cells(iPBRaekke - 1, 2).Font.Bold = True Then
If Cells(iPBRaekke - 2, 1).Font.Bold = True
Then
Rows(iPBRaekke - 2).PageBreak =
xlPageBreakManual
GoTo SlutCheck
Else
Rows(iPBRaekke - 1).PageBreak =
xlPageBreakManual
GoTo SlutCheck
End If
End If '(3)
'-------------------------------------------------
-----
'(4) Checker om rækken 2 over eller rækken 3 over
indeholder overskrift
If Cells(iPBRaekke - 2, 2).Font.Bold = True Then
If Cells(iPBRaekke - 3, 1).Font.Bold = True
Then
Rows(iPBRaekke - 3).PageBreak =
xlPageBreakManual
GoTo SlutCheck
Else
Rows(iPBRaekke - 2).PageBreak =
xlPageBreakManual
GoTo SlutCheck
End If
End If '(4)
'-------------------------------------------------
-----
'(5) Checker om der er 2 eller flere linier på
næste side
If Cells(iPBRaekke, 3).Value = 0 Then
GoTo SlutCheck
Else
If Cells(iPBRaekke + 1, 3).Value = 0 Then
Cells(iPBRaekke, 2).Select
Selection.End(xlUp).Select
If Selection.Offset(-1, -1).Font.Bold =
True Then
Rows(Selection.Offset(-1, -
1).Row).PageBreak = xlPageBreakManual
Else
Rows(Selection.Row).PageBreak =
xlPageBreakManual
End If
End If
End If '(5)
'End If '(0)
iPBRaekke = pb.Location.Row
MsgBox iPBRaekke
SlutCheck:
Next
Range(sStartCelle).Select
Application.ScreenUpdating = True
SlutTid = Time
tid = (SlutTid - StartTid) * 24 * 3600
'MsgBox tid
End Sub