Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Вставка разрывов по условию
 
В моем примере необходимо вставлять вертикальный разрыв страницы на следующих условиях:
Если в полях проверки стоят "графика" и "номер" то разрыв перемещаем до текста выше. Текстовых строк может быть от 0 и более между графикой. Графика всегда 8 строк.
Предполагается что данных много, выполнять надо в цикле как я понимаю...
Изменено: Sla_0412 - 5 Май 2015 14:55:04
 
Цитата
как я понимаю...
А я, так понимаю, что нужен горизонтальный разрыв
 
да, мне нужно только по горизонтали
 
И еще, сколько строк умещается на странице?
Используйте
Цитата
ActiveSheet.HPageBreaks.Add ячейка
разрыв над ячейкой
Изменено: Kuzmich - 5 Май 2015 14:55:22
 
Проблема состоит в том что при использовании ActiveSheet.HPageBreaks.Add ячейка, я смог только сдвинуть первый разрыв, который влияет на последующие разрывы ниже по строкам. те никак не соображу как зациклить обработку если информация всегда размещается вразнобой.(листов множество и комбинации текста и графики разные)
 
Попробуйте так
Код
Sub Razdel_31()
Dim i As Long
Dim iLastRow As Long
Dim iPage As Long
    iLastRow = Cells(Rows.Count, 4).End(xlUp).Row
      iPage = 1
  For i = 1 To iLastRow
    Do
      If Cells(i, 5) = "графика" Then
        If i + 7 >= 32 * iPage Then Exit Do
        i = i + 8
      Else
        If i + 1 >= 32 * iPage Then Exit Do
        i = i + 1
      End If
    Loop While i < 32 * iPage
        ActiveSheet.HPageBreaks.Add Cells(i + 1, 1)
      iPage = iPage + 1
  Next
End Sub
 
Я может как то неправильно описал задачу, но во первых, файл выложен как пример и привязываться к его размерам высоты строк а так же к ориентации листа никак нельзя. Предполагается использовать метод для разных целей (отчеты разных документов) , на разных компьютерах, с разными принтерами. Во-вторых , он даже в том виде в котором есть, не отрабатывает  свою задачу.(Это легко проверить скопировав текст примера вниз и продолжив ряд строк.
Я вижу алгоритм так: находим первый разрыв, смещаем его на n количество строк вверх до текста. Далее повторяем задачу до конца. Фишка в том что при смещении первого разрыва, остальные "переходят" тоже вверх.
 
Цитата
Sla_0412 написал: Фишка в том что при смещении первого разрыва, остальные "переходят" тоже вверх.
И?
По по очереди проверяем все разрывы, если нужно - двигаем.
 
Попробуйте так
Код
Sub Razdel_31()
Dim i As Long
Dim iLastRow As Long
Dim iPage As Long
Dim iHPBreak As HPageBreak
Dim KolStrok As Long
   For Each iHPBreak In ActiveSheet.HPageBreaks
    iHPBreak.Delete
   Next
  KolStrok = ActiveSheet.HPageBreaks(1).Location.Row - 1
    iLastRow = Cells(Rows.Count, 4).End(xlUp).Row
      iPage = 1
  For i = 1 To iLastRow
    Do
      If Cells(i, 5) = "графика" Then
        If i + 8 >= KolStrok * iPage Then Exit Do
        i = i + 8
      Else
        If i + 1 >= KolStrok * iPage Then Exit Do
        i = i + 1
      End If
    Loop While i <= KolStrok * iPage
        ActiveSheet.HPageBreaks.Add Cells(i, 1)
      iPage = iPage + 1
  Next
End Sub
 
Все работает, но нужно вставить между строкой 6 и 7 On Error Resume Next.
Выражаю огромную благодарность Kuzmich.
 
Здравствуйте! У меня вопрос по этой теме. мне надо поставить разрыв перед словом "карточка" (т.е. каждая карточка должна начинаться с новой страницы при печати).
предыдущий макрос у меня почему-то не сработал, наверное там надо что-то поменять, кроме слова графика?
помогите пожалуйста.
 
Попробуйте так Параметры страницы - Поля верхнее 1, нижнее - 1,5 колонтитулы - 0
Код
Sub Razdel_31()
Dim i As Long
Dim iLastRow As Long
Dim iPage As Long
Dim iHPBreak As HPageBreak
Dim KolStrok As Long
    On Error Resume Next
   For Each iHPBreak In ActiveSheet.HPageBreaks
    iHPBreak.Delete
   Next
  KolStrok = ActiveSheet.HPageBreaks(1).Location.Row - 1
    iLastRow = Cells(Rows.Count, 34).End(xlUp).Row
      iPage = 1
  For i = 2 To iLastRow
    Do
      If Cells(i, 21) = "КАРТОЧКА" Then
        If i + 60 >= KolStrok * iPage Then Exit Do
        i = i + 60
      Else
        If i + 1 >= KolStrok * iPage Then Exit Do
        i = i + 1
      End If
    Loop While i <= KolStrok * iPage
        ActiveSheet.HPageBreaks.Add Cells(i, 1)
      iPage = iPage + 1
  Next
End Sub



 
Kuzmich, спасибо, работает!!!
 
захотела сама подогнать макрос под другой файл... видно не дано..... посмотрите, что не так?
Код
Sub Razdel_31()
Dim i As Long
Dim iLastRow As Long
Dim iPage As Long
Dim iHPBreak As HPageBreak
Dim KolStrok As Long
    On Error Resume Next
   For Each iHPBreak In ActiveSheet.HPageBreaks
    iHPBreak.Delete
   Next
  KolStrok = ActiveSheet.HPageBreaks(1).Location.Row - 1
    iLastRow = Cells(Rows.Count, 130).End(xlUp).Row
      iPage = 1
  For i = 2 To iLastRow
    Do
      If Cells(i, 1) = "Расчетный листок за Май 2015" Then
        If i + 25 >= KolStrok * iPage Then Exit Do
        i = i + 25
      Else
        If i + 1 >= KolStrok * iPage Then Exit Do
        i = i + 1
      End If
    Loop While i <= KolStrok * iPage
        ActiveSheet.HPageBreaks.Add Cells(i, 1)
      iPage = iPage + 1
  Next
End Sub
 
temash, для оформления кода - кнопка <...>
 
vikttur, извините, буду знать
 
Макрос попроще
Код
Sub q()
    Dim r As Range
    Set r = Cells.Find(What:="Расчетный листок", LookAt:=xlPart)
    If Not r Is Nothing Then
        Do
            If r Is Nothing Or r.Row = 1 Then Exit Do
            ActiveSheet.HPageBreaks.Add r
            Set r = Cells.FindNext(r)
        Loop
    End If
End Sub
 
Цитата
посмотрите, что не так?
В 130 столбце нет данных, ищите последнюю строку по первому столбцу
Код
 iLastRow = Cells(Rows.Count, 130).End(xlUp).Row
 
RAN, спасибо большое, работает
Kuzmich, поняла, спасибо

ВЫ ГЕНИИ!!!!!
 
Файл экспортируется в PDF количество столбцов 36, количество сток 69, количество листов, выводимых на печать от 1-го до 8ми, зависит от скрытых строк.
Как зафиксировать разрывы страниц (вертикальных и горизонтальных согласно этому условию, с растягиванием области печати на стандартный А4.
Ширина столбца4, высота строки 21,5 - 21 фиксируется, масштаб - 55.
Файл используется разными пользователями, в зависимости от настроек разметка "уплывает"((
Судя по тому, как это работает в ручном режиме, перед установкой границ требуется их сброс.
Изменено: Negramotny - 4 Май 2017 19:52:43
Страницы: 1
Читают тему (гостей: 1)