Ручная вставка разрыва страницы

Public Sub Pages1()
    MsgBox (ActiveDocument.ActiveWindow.Panes(1).Pages.Count)
End Sub

Public Sub Page1()
    Dim Type1 As Integer
    Dim i As Integer
    Dim a As Integer
    Dim b As Integer
    i = 0
 
    For Each Rectangle1 In ActiveDocument.ActiveWindow.Panes(1).Pages(1).Rectangles
        ' Pages(2) - это вторая страница активного документа
        
        Type1 = Rectangle1.RectangleType
        If Type1 = 0 Then
            Select1 = Rectangle1.Range.Text
            If i = 0 Then
                a = Rectangle1.Range.Start
            End If
            i = i + 1
            b = Rectangle1.Range.End
        End If
    Next [Rectangle1]
    ActiveDocument.Range(a, b).Select
End Sub

Public Sub Page2()
    Dim CountPages As Integer
    Dim Count1 As Integer
    Dim Count2 As Integer
    CountPages = ActiveDocument.ActiveWindow.Panes(1).Pages.Count
    Count1 = ActiveWindow.Panes(1).Pages(CountPages).Rectangles.Count
    If CountPages > 1 Then
        Count2 = ActiveWindow.Panes(1).Pages(CountPages - 1).Rectangles.Count
    End If
    If Count1 = 20 Then
        ActiveWindow.Panes(1).Pages(CountPages - 1).Rectangles(Count2 - 4).Range.Select
        Selection.InsertBreak Type:=wdPageBreak
    End If
End Sub

Public Sub Page2()
    Dim CountPages As Integer 'общее количество страниц при печати
    Dim CountRow As Integer 'общее количество строк
    Dim CountCol As Integer 'общее количество столбцов
    Dim Count1 As Integer 'количество страниц по вертикали
    Dim Count2 As Integer 'количество страниц по горизонтали
    Dim CountLastPageRow As Integer 'номер строки нижней части предпоследней страницы по вертикали
    Dim CountLastPageCol As Integer 'номер столбца правой части предпоследней страницы по горизонтали
    CountPages = Worksheets(1).PageSetup.Pages.Count
    CountRow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
    CountCol = ActiveCell.SpecialCells(xlCellTypeLastCell).Column
    Count1 = ActiveSheet.HPageBreaks.Count
    Count2 = ActiveSheet.VPageBreaks.Count
    CountLastPageRow = ActiveSheet.HPageBreaks(ActiveSheet.HPageBreaks.Count).Location.Row - 1
    CountLastPageCol = ActiveSheet.VPageBreaks(ActiveSheet.VPageBreaks.Count).Location.Column - 1
    If Count1 > 1 Then
        If (CountRow - CountLastPageRow) = 20 Then
            ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(CountLastPageRow - 4, 1)
        End If
    End If
End Sub

Public Sub Page2()
    Dim CountPages As Integer 'общее количество страниц при печати
    Dim CountRow As Integer 'общее количество строк
    Dim CountCol As Integer 'общее количество столбцов
    Dim Count1 As Integer 'количество страниц по вертикали
    Dim Count2 As Integer 'количество страниц по горизонтали
    Dim CountLastPageRow As Integer 'номер строки нижней части предпоследней страницы по вертикали
    Dim CountLastPageCol As Integer 'номер столбца правой части предпоследней страницы по горизонтали
    CountPages = Worksheets(1).PageSetup.Pages.Count
    CountRow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
    CountCol = ActiveCell.SpecialCells(xlCellTypeLastCell).Column
    Count1 = ActiveSheet.HPageBreaks.Count
    Count2 = ActiveSheet.VPageBreaks.Count
    CountLastPageRow = ActiveSheet.HPageBreaks(ActiveSheet.HPageBreaks.Count).Location.Row - 1
    CountLastPageCol = ActiveSheet.VPageBreaks(ActiveSheet.VPageBreaks.Count).Location.Column - 1
    If Count2 = 1 Then
        If Count1 > 1 Then
            If (CountRow - CountLastPageRow) = 20 Then
                ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(CountLastPageRow - 4, 1)
            End If
        End If
    Else
        MsgBox "Файл не умещается в ширину на страницу. Количество страниц в ширину: " & Count2
    End If
End Sub

Option Explicit
 
Const FIRST_ROW& = 28
Const FIRST_COL$ = "J"
Const LAST_COL$ = "P"
Const ITOGO_COL$ = "I"
 
Sub CreatePageSubtotals()
Dim iPageNum&, viewState, hpb As HPageBreak, iRow1&, iRow2&
Dim count_pages As Variant
Dim totalRow As Variant
Dim a As Integer
 
Dim fl As Boolean
Dim rowI As Integer
 
 
Dim R As Range, zoom
Dim wR As Range, Row As Range, C As Range, _
      HrAlg, CurH, NewH
Dim Ar As Range
Dim breakcount As Integer
Dim temp As Double
 
breakcount = ActiveSheet.HPageBreaks.Count
 
Dim CountPages As Integer '????? ?????????? ??????? ??? ??????
    Dim CountRow As Integer '????? ?????????? ?????
    Dim CountCol As Integer '????? ?????????? ????????
    Dim Count1 As Integer '?????????? ??????? ?? ?????????
    Dim Count2 As Integer '?????????? ??????? ?? ???????????
    Dim CountLastPageRow As Integer '????? ?????? ?????? ????? ????????????? ???????? ?? ?????????
    Dim CountLastPageCol As Integer '????? ??????? ?????? ????? ????????????? ???????? ?? ???????????
    CountPages = Worksheets(1).PageSetup.Pages.Count
    CountRow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
    CountCol = ActiveCell.SpecialCells(xlCellTypeLastCell).Column
    Count1 = ActiveSheet.HPageBreaks.Count
    Count2 = ActiveSheet.VPageBreaks.Count
    CountLastPageRow = ActiveSheet.HPageBreaks(ActiveSheet.HPageBreaks.Count).Location.Row - 1
    CountLastPageCol = ActiveSheet.VPageBreaks(ActiveSheet.VPageBreaks.Count).Location.Column - 1
    If Count2 = 1 Then
        If Count1 > 1 Then
            If (CountRow - CountLastPageRow) < 23 Then
                ActiveSheet.HPageBreaks.Add Before:=Cells(CountLastPageRow - 5, 1)
            End If
        End If
    Else
        
    End If
    
    breakcount = ActiveSheet.HPageBreaks.Count
 
 
'Stop
 
rowI = 0
 
'zoom = ActiveSheet.PageSetup.zoom
'ActiveSheet.ResetAllPageBreaks
'ActiveSheet.PageSetup.zoom = zoom
 
Set R = Range("ÈòîãèÏîäïèñè")
  Set R = R.Offset(-1, 0).Resize(R.Rows.Count + 1, R.Columns.Count)
  R.Rows.PageBreak = xlPageBreakNone
  For Each wR In R.Rows
    If wR.PageBreak = xlPageBreakAutomatic Then
      'R.Rows.PageBreak = xlPageBreakManual
      rowI = R.Rows.Row
      'rowI = 1
    End If
  Next
 
 
 
      
' ' àâòîôèò
'Application.ScreenUpdating = False
'Application.EnableEvents = False
'Application.Calculation = xlCalculationManual
'
'
'
'  totalRow = Range("totalRow").Row
'
'  Set R = Range("B24:B" & totalRow - 1)
'
'  Set wR = Application.Intersect(R, R.Worksheet.UsedRange)
'
'  For Each Row In wR.Rows
'    CurH = Row.RowHeight
'    NewH = CurH
'    For Each C In Row.Cells
'      If C.MergeCells And C.WrapText And C.Column = C.MergeArea.Column Then
'        Set Ar = C.MergeArea
'        HrAlg = C.HorizontalAlignment
'        Ar.MergeCells = False
'        Ar.HorizontalAlignment = xlCenterAcrossSelection
'        Ar.Rows.AutoFit
'        If NewH < Ar.RowHeight Then
'          NewH = Ar.RowHeight
'        End If
'        Ar.MergeCells = True
'        Ar.HorizontalAlignment = HrAlg
'      End If
'    Next
'    Row.RowHeight = NewH
'    Next
 
 
totalRow = Range("totalRow").Row
fl = False
 
For a = 28 To totalRow
 
 Cells(a, 10).Value = Cells(a, 10).Value
 Cells(a, 11).Value = CDbl(Cells(a, 11).Value)
 Cells(a, 13).Value = CDbl(Cells(a, 13).Value)
 Cells(a, 15).Value = CDbl(Cells(a, 15).Value)
 Cells(a, 16).Value = CDbl(Cells(a, 16).Value)
Next
 
 
 
count_pages = ActiveWorkbook.Sheets.HPageBreaks.Count + 1
 
If count_pages = 1 Then
  Exit Sub
End If
 
totalRow = Range("totalRow").Row
 
viewState = ActiveWindow.View
ActiveWindow.View = xlPageBreakPreview
iRow1 = FIRST_ROW
For Each hpb In ActiveSheet.HPageBreaks
    iPageNum = iPageNum + 1
    iRow2 = hpb.Location.Row - 1
    
    If iRow2 >= totalRow + 20 Then
    
    fl = True
    Exit For
    
    End If
    
    If iRow2 >= totalRow Then
    
    iRow2 = rowI
    
    End If
    
    
'    If iRow2 = R.Rows.Row - 1 Then
'        R.Rows.PageBreak = xlPageBreakNone
'    End If
    
    Rows(iRow2).Insert
    Rows(iRow2 + 1).PageBreak = xlPageBreakManual
    Cells(iRow2, ITOGO_COL) = "Èòîãî ïî ñòðàíèöå " & iPageNum & ":"
    'Cells(iRow2, "J") = "Èòîãî ïî ñòðàíèöå " & iPageNum & ":"
    Range(Cells(iRow2, FIRST_COL), Cells(iRow2, LAST_COL)).FormulaR1C1 = _
        "=SUBTOTAL(9,R[" & iRow1 - iRow2 & "]C:R[-1]C)"
    Rows(iRow2).Font.Bold = True
    Rows(iRow2).Font.Size = 6
    
    Range("I" & iRow2).Select
    With Selection
        .Font.Size = 6
        .HorizontalAlignment = xlRight
    End With
    
    Cells(iRow2, 12).Value = "X"
    Cells(iRow2, 14).Value = "X"
    
    iRow1 = iRow2 + 1
    
Next
 
If fl = False Then
 
'Cells(iRow2, 11).Value = "X"
Cells(iRow2, 12).Value = "X"
Cells(iRow2, 14).Value = "X"
 
iRow2 = totalRow + iPageNum
Rows(iRow2).Insert
Cells(iRow2, ITOGO_COL) = "Èòîãî ïî ñòðàíèöå " & iPageNum + 1 & ":"
With Range(Cells(iRow2, FIRST_COL), Cells(iRow2, LAST_COL))
    .FormulaR1C1 = "=SUBTOTAL(9,R[" & iRow1 - iRow2 & "]C:R[-1]C)"
    .NumberFormat = "0.00"
End With
Range(iRow2 & ":" & iRow2 + 1).Font.Bold = True
Range(iRow2 & ":" & iRow2 + 1).Font.Size = 6
 
Range("I" & iRow2).Select
With Selection
    .Font.Size = 6
    .HorizontalAlignment = xlRight
End With
 
 
 
Cells(iRow2, 12).Value = "X"
Cells(iRow2, 14).Value = "X"
'Cells(iRow2, 14).Value = "X"
End If
 
' --> ïîäìåíà äàííûõ â ôóòåðå. Äîáàâëåíî À. Æàëóäêîâûì
ActiveSheet.PageSetup.RightFooter = "Ñòðàíèöà " & "&P" & " Òîâàðíàÿ íàêëàäíàÿ ¹ " & Cells(23, 6).Value & " îò " & Cells(23, 8).Value
' <-- Âñòàâêà ëîãèêè îáðàáîòêè ôóòåðà çàâåðøåíà
 
 
'zoom = ActiveSheet.PageSetup.zoom
'ActiveSheet.ResetAllPageBreaks
'ActiveSheet.PageSetup.zoom = zoom
 
'iRow2 = iRow2 + 1
'Cells(iRow2, ITOGO_COL) = "Âñåãî ïðèõîä:"
'With Range(Cells(iRow2, FIRST_COL), Cells(iRow2, LAST_COL))
'    .FormulaR1C1 = "=SUBTOTAL(9,R[" & FIRST_ROW - iRow2 & "]C:R[-1]C)"
'    .NumberFormat = "0.00"
'End With
 
ActiveWindow.View = viewState
 
'--------------------------------------------------------->
 
'------------------------------------------------------------<
  
 
 
 
'Âñåãî ïðèõîä:
End Sub
 
Sub del_pic()
    ActiveSheet.Shapes.Range(Array("Ðèñóíîê 1")).Select
    Selection.Delete
End Sub
 
Sub text_del()
    Cells(1, 1).Select
    Selection.Clear
End Sub
 
 
 
 
 
'Sub setHeader()
'Cells(1, 1).Value = "Óâåäîìëåíèå! Äåíåæíîå òðåáîâàíèå ïî îïëàòå íèæåóêàçàííûõ ïîñòàâëåííûõ òîâàðîâ óñòóïëåíî Ïîñòàâùèêîì ÏÀÎ  «Ïðîìñâÿçüáàíê» (ÎÃÐÍ 1027739019142) íà îñíîâàíèè Ãåíåðàëüíîãî äîãîâîðà îá îáùèõ óñëîâèÿõ ôàêòîðèíãîâîãî îáñëóæèâàíèÿ ïîñòàâîê âíóòðè Ðîññèè îò" + Chr(34) + "02" + Chr(34) + "ìàðòà 2010ã. ¹ 070-ÂÐ-47-10, â ñâÿçè ñ ýòèì îïëàòó òîâàðîâ íåîáõîäèìî îñóùåñòâëÿòü  èñêëþ÷èòåëüíî â ïîëüçó ßðîñëàâëüñêèé ô-ë ÏÀÎ" + Chr(34) + "Ïðîìñâÿçüáàíê" + Chr(34) + "ïî ñëåäóþùèì ðåêâèçèòàì: ÈÍÍ/ÊÏÏ 7744000912 / 760402001, êîð/ñ÷åò 30101810300000000760; ÁÈÊ 047888760, ñ÷åò ¹ 47402810532000846601"
'End Sub

ActiveSheet.HPageBreaks.Count