Excel это не сложно
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
29.03.2024, 15:59:41

Войти
Хотите поблагодарить участника за дельный совет? Нажмите [Повысить]. Так вы заслуженно поднимите репутацию активному участнику.
33 233 Сообщений в 5 454 Тем от 6 753 Пользователей
Последний пользователь: malanik777
*
Перейти на сайт Хитрости Надстройка MulTEx Обучающие тренинги Наша группа ВКонтакте
Правила форума Начало Помощь Поиск Календарь Войти Регистрация Выйти
+  Excel это не сложно
|-+  Основные форумы
| |-+  Вопросы по Excel и VBA
| | |-+  автоматический разрыв строки в Excel при печати более 2 листов
Страниц: [1]   Вниз
Печать
Автор Тема: автоматический разрыв строки в Excel при печати более 2 листов  (Прочитано 2715 раз)
0 Пользователей и 1 Гость смотрят эту тему.
Stasssy
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 4


373229984
Просмотр профиля E-mail
« : 11.01.2021, 13:49:04 »

Добрый день, помогите, пожалуйста, профану в мире макросов.

Есть шаблон в Экселе, благодаря которому из программы выгружается отчет. Отчет может быть длиной в 1 страницу, тогда проблем нет, но бывает, что на одной странице первый подписант, а на вторую переносится второй подписант. Можно ли сделать чтобы в таких случаях был разрыв со строки  ИТОГО и обеими подписями переносился на след.страницу автоматически?

Записан

А в мире есть такие дороги, куда боятся соваться Боги, а мы назло всем стихиям петляем то в ад, то в рай...
Дмитрий Щербаков(The_Prist)
Администратор
Ветеран
*****

Репутация: +485/-0
Офлайн Офлайн

Сообщений: 5 828



Просмотр профиля WWW
« Ответ #1 : 11.01.2021, 16:00:50 »

При таких исходных данных(ни файла ни нормального скрина) ответ только такой может быть:
проверяете нужные ячейки через If ... Then и если подписанты(или кто там еще) выходят за пределы 1-ой страницы, то принудительно выставляете там разрыв страницы. Грубо как-то так:
Код: (vb)
Sub ReorderPageBreaks()
    Dim lr As Long, lpb As Long, lsign As Long
    Dim IsNeedBreak As Boolean
   
    ActiveWindow.View = xlNormalView
    For lr = 1 To 50
        If Rows(lr).PageBreak <> xlPageBreakNone Then
            lpb = lpb + 1
        End If
        If Cells(lr, 1).Value = "ПОДПИСАНТ" Then
            lsign = lsign + 1
            If lsign > 1 Then
                If lpb > 0 Then
                    IsNeedBreak = True
                    Exit For
                End If
            End If
        End If
    Next
   
    If IsNeedBreak Then
        Cells.PageBreak = xlPageBreakNone
        For lr = 1 To 50
            If Cells(lr, 1).Value = "ИТОГО" Then
                Rows(lr).PageBreak = xlPageBreakManual
            End If
        Next
    End If
End Sub

При небольших доработках вполне должно сработать.
Записан

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Пункты приёма Спасибов:    -41001332272872  -R298726502453
Stasssy
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 4


373229984
Просмотр профиля E-mail
« Ответ #2 : 12.01.2021, 12:53:54 »

Вложила файл чтобы было понятнее было что нужно. макрос попробовала вставить, но все равно при формировании ведомости из программы печать разрывает на две страницы по половине.. на доработку мозгов не хватает.  Обеспокоенный Нашла подобную проблему , но ответа на нее тоже не нашла:
(картинка открывается крупнее, если в новой вкладке это изображение открыть)
Записан

А в мире есть такие дороги, куда боятся соваться Боги, а мы назло всем стихиям петляем то в ад, то в рай...
Дмитрий Щербаков(The_Prist)
Администратор
Ветеран
*****

Репутация: +485/-0
Офлайн Офлайн

Сообщений: 5 828



Просмотр профиля WWW
« Ответ #3 : 12.01.2021, 13:12:22 »

По сути Вам надо было лишь чуточку подработать код:
Код: (vb)
Sub ReorderPageBreaks()
    Dim lr As Long, lpb As Long, lsign As Long
    Dim IsNeedBreak As Boolean
      
    ActiveWindow.View = xlNormalView
    For lr = 1 To 50
        If Rows(lr).PageBreak <> xlPageBreakNone Then
            lpb = lpb + 1
        End If
        If InStr(1, Cells(lr, 5).Value, "Уполномоченный представитель", 1) Then
            lsign = lsign + 1
            If lsign > 1 Then
                If lpb > 0 Then
                    IsNeedBreak = True
                    Exit For
                End If
            End If
        End If
    Next
      
    If IsNeedBreak Then
        Cells.PageBreak = xlPageBreakNone
        For lr = 1 To 50
            If Cells(lr, 2).Value = "ИТОГО" Then
                Rows(lr).PageBreak = xlPageBreakManual
            End If
        Next
    End If
End Sub

Потому что и надписи у Вас не в первом столбце и сами представитель надо искать по части совпадения.

P.S. Да, скрин можно открыть в другой вкладке. Но это все равно не дает четкого понимания в каких столбцах записаны данные и как они записаны в ячейках  Улыбка

А этот код уже более универсален - он сначала определяем нужны ли разрывы и делает их только в этом случае. Если же все умещается на одну страницу и так - то он ничего не делает. Плюс он автоматом сам определяет кол-во строк и переназначает область печати, если кол-во изменилось:
Код: (vb)
Sub ReorderPageBreaks()
    Dim lr As Long, lpb As Long, lsign As Long
    Dim IsNeedBreak As Boolean
    'определяем область печати
    lr = Cells(Rows.Count, 5).End(xlUp).Row
    ActiveSheet.PageSetup.PrintArea = Range("A1:AL" & lr + 3).Address
    ActiveWindow.View = xlNormalView
    For lr = 1 To lr
        If Rows(lr).PageBreak <> xlPageBreakNone Then
            lpb = lpb + 1
        End If
    Next
    'разрывы не нужны - все умещается в одну стриницу
    If lpb = 0 Then
        Exit Sub
    End If
    lpb = 0
    'разрывы нужны - ищем место
    For lr = 1 To lr
        If Rows(lr).PageBreak <> xlPageBreakNone Then
            lpb = lpb + 1
        End If
        If InStr(1, Cells(lr, 5).Value, "Уполномоченный представитель", 1) Then
            lsign = lsign + 1
            If lsign > 1 Then
                If lpb > 0 Then
                    IsNeedBreak = True
                    Exit For
                End If
            End If
        End If
    Next
     
    If IsNeedBreak Then
        Cells.PageBreak = xlPageBreakNone
        For lr = 1 To lr
            If Cells(lr, 2).Value = "ИТОГО" Then
                Rows(lr).PageBreak = xlPageBreakManual
            End If
        Next
    End If
End Sub
« Последнее редактирование: 12.01.2021, 13:17:51 от Дмитрий Щербаков(The_Prist) » Записан

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Пункты приёма Спасибов:    -41001332272872  -R298726502453
Stasssy
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 4


373229984
Просмотр профиля E-mail
« Ответ #4 : 12.01.2021, 14:59:28 »

Огромное спасибо, Дмитрий, Вы очень умны, но еще и добры Улыбка

p.s. вроде работает! это чудесно, только пока не получается почему-то настроить автоматическое включение данного макроса. делаю как пишут через Private Sub Workbook_Open(). но не запускается Непонимающий
Записан

А в мире есть такие дороги, куда боятся соваться Боги, а мы назло всем стихиям петляем то в ад, то в рай...
Дмитрий Щербаков(The_Prist)
Администратор
Ветеран
*****

Репутация: +485/-0
Офлайн Офлайн

Сообщений: 5 828



Просмотр профиля WWW
« Ответ #5 : 12.01.2021, 15:38:10 »

автоматическое включение данного макроса
чтобы помочь в этом надо как минимум понимать в какой момент должен происходит запуск макроса. Автоматически - от чего? Что должно произойти, чтобы макрос сработал?
Записан

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Пункты приёма Спасибов:    -41001332272872  -R298726502453
Stasssy
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 4


373229984
Просмотр профиля E-mail
« Ответ #6 : 12.01.2021, 15:54:01 »

при открытии документа. то есть я выгружаю из программы ведомость по данному шаблону, нажимаю предпросмотр - печать разрывается.
тогда я запускаю макрос (вручную) - строка с подписантами и строкой ИТОГО переносится как мне и нужно.

возможна ли настройка так, чтобы при выгрузке ведомости макрос запускался автоматически и не надо было бы его принудительно запускать..

не исключено, что я опять туплю конечно Обеспокоенный
Записан

А в мире есть такие дороги, куда боятся соваться Боги, а мы назло всем стихиям петляем то в ад, то в рай...
Дмитрий Щербаков(The_Prist)
Администратор
Ветеран
*****

Репутация: +485/-0
Офлайн Офлайн

Сообщений: 5 828



Просмотр профиля WWW
« Ответ #7 : 12.01.2021, 19:30:54 »

при выгрузке ведомости
если выгрузка происходит при помощи сторонней программы, то событие Workbook_Open здесь ни при чем, т.к. срабатывает исключительно при открытии книги. И то, если книга открыта руками или другим кодом. Из другой программы 99%, что событие не сработает.
Записан

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Пункты приёма Спасибов:    -41001332272872  -R298726502453
Страниц: [1]   Вверх
Печать
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2011, Simple Machines Valid XHTML 1.0! Valid CSS!
Яндекс.Метрика Рейтинг@Mail.ru