В моем примере необходимо вставлять вертикальный разрыв страницы на следующих условиях: Если в полях проверки стоят "графика" и "номер" то разрыв перемещаем до текста выше. Текстовых строк может быть от 0 и более между графикой. Графика всегда 8 строк. Предполагается что данных много, выполнять надо в цикле как я понимаю...
Проблема состоит в том что при использовании 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 количество строк вверх до текста. Далее повторяем задачу до конца. Фишка в том что при смещении первого разрыва, остальные "переходят" тоже вверх.
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
Здравствуйте! У меня вопрос по этой теме. мне надо поставить разрыв перед словом "карточка" (т.е. каждая карточка должна начинаться с новой страницы при печати). предыдущий макрос у меня почему-то не сработал, наверное там надо что-то поменять, кроме слова графика? помогите пожалуйста.
Попробуйте так Параметры страницы - Поля верхнее 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
захотела сама подогнать макрос под другой файл... видно не дано..... посмотрите, что не так?
Код
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
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
Ребята, помогите, плиз прописать макрос. У самой ничего не получается. В табличке, которая прикреплена, нужен разрыв страницы по первой колонке "ветка". И чтобы на одной страничке было только 23 строки. Буду очень благодарна за помощь
Добрый день. Подскажите, пожалуйста, какие изменения нужно внести в Ваш макрос, чтобы разрывы проставлялись каждые N строк (например, каждые 30 строк)?
Sub ВставитьРазрыв()
Dim i As Long
Dim iLastRow As Long
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
ActiveSheet.ResetAllPageBreaks
i = 24
Do While i < iLastRow
ActiveSheet.HPageBreaks.Add ActiveSheet.Range("A" & i)
i = i + 23
Loop
End Sub
Если можете, помогите, пожалуйста, с похожей задачей.
Есть стандартная накладная в которой есть шапка накладной, тело (таблица с товарами), а так же подписи. При печати документа бывает так, что подпись (или ее часть) отрываются от основной части таблицы. Параметры печати: вписать все столбцы на одном листе. Все поля по 0,8 см. Колонтитулы по 0 см.
Можно ли проверить находятся начало подписи и конец на одном листе и, если да, то проверить не оторвана ли подпись от основной таблицы? И в зависимости от сложности реализации или уменьшить на 1 выводимые на печать количество страниц или добавить разрыв перед последней строкой табличной части?