Developing.ru

Всем привет. Мне нужно, чтобы одновременно исполнялось несколько условий:
1. разрыв страницы был в конце таблицы (для 1 таблицы это условие исполняется не всегда)
2. на странице, если это возможно, помещалось несколько таблиц

Выкладываю код программы и 3 примера, на которых этот код необходимо выполнить.
Максимальное количество таблиц есть в примере 1. В других примерах количество и размер таблиц может уменьшатся.
Примеров может быть сотни.

Код: Выделить всё

Sub vytraty()
'
'
Dim m As Integer
Dim g As Integer, u As Integer, p As Integer, ss As Integer

    p = Cells.Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    m = Range(Rows(7).End(xlDown).Address).Row + 5
    u = 1
    If m - 5 - ActiveSheet.HPageBreaks(1).Location.Row >= 3 Then
        u = 2
        m = Range(Rows(m).End(xlDown).Address).Row + 5
    End If
    If m - 5 - ActiveSheet.HPageBreaks(1).Location.Row <= 2 And m - 5 >= ActiveSheet.HPageBreaks(1).Location.Row Then
        Set ActiveSheet.HPageBreaks(1).Location = Range("A" & m - 4)
        u = 2
        m = Range(Rows(m).End(xlDown).Address).Row + 5
    End If
    g = ActiveSheet.HPageBreaks.Count
    If g = 0 Then GoTo 10
    Do While u <= g
        DoEvents
        'повтор
        ss = 0
4       If Range(Rows(m - 5).End(xlUp).Address).Row - 3 < ActiveSheet.HPageBreaks(u).Location.Row _
        And m - 5 >= ActiveSheet.HPageBreaks(u).Location.Row Then
            Set ActiveSheet.HPageBreaks(u).Location = Range("A" & Range(Rows(m - 5).End(xlUp).Address).Row - 4)
            GoTo 5
        End If
        If m - 5 = ActiveSheet.HPageBreaks(u).Location.Row - 1 Then GoTo 5
        m = Range(Rows(m).End(xlDown).Address).Row + 5
        If m >= p Then
            If Range(Rows(m - 5).End(xlUp).Address).Row - 3 < ActiveSheet.HPageBreaks(u).Location.Row _
            And m - 5 >= ActiveSheet.HPageBreaks(u).Location.Row Then
                Set ActiveSheet.HPageBreaks(u).Location = Range("A" & Range(Rows(m - 5).End(xlUp).Address).Row - 4)
                GoTo 10
            End If
        End If
        ss = ss + 1
        If ss <= 4 Then GoTo 4
5       u = u + 1
        g = ActiveSheet.HPageBreaks.Count
    Loop
10 ActiveWindow.Zoom = 95
Range("A2").Select
ActiveWindow.ScrollRow = 1
End Sub

Developing.ru

разрыв страниц в конце таблиц

разрыв страниц в конце таблиц