Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 06.12.2009, 18:42   #1
Jaroslav
Форумчанин
 
Регистрация: 08.06.2009
Сообщений: 179
По умолчанию разрыв страниц в конце таблиц

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


Код:
Sub vytraty()
'
'
Dim m As Integer
Dim g As Integer, u As Integer, p As Integer, ss As Integer

    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
Вложения
Тип файла: zip primery.zip (20.7 Кб, 22 просмотров)
Jaroslav вне форума Ответить с цитированием
Старый 06.12.2009, 18:45   #2
Jaroslav
Форумчанин
 
Регистрация: 08.06.2009
Сообщений: 179
По умолчанию

Примеров может быть сотни.
Jaroslav вне форума Ответить с цитированием
Старый 06.12.2009, 19:32   #3
Jaroslav
Форумчанин
 
Регистрация: 08.06.2009
Сообщений: 179
По умолчанию

Ребята, извините, в начале программы забыл на форуме дописать строчку:
Код:
p = Cells.Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
Jaroslav вне форума Ответить с цитированием
Старый 08.12.2009, 10:24   #4
Jaroslav
Форумчанин
 
Регистрация: 08.06.2009
Сообщений: 179
По умолчанию

Вопрос, наверное, сложный даже для профессионалов.
А если убрать условие № 3 "масштаб страницы был не менее 80%", это упростит задачу?
Jaroslav вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Разрыв в графике Series tavrocotaps Общие вопросы Delphi 8 07.12.2009 11:12
мусор в конце строк zmaxon Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM 0 06.12.2009 17:35
Сумма по полям в конце таблицы Subscriber SQL, базы данных 8 05.03.2009 13:49
Как обработать разрыв связи ADO с БД slips БД в Delphi 3 18.11.2008 16:53