Доброго времени суток Форумчане. Помогите пожалуйста доработать макрос (это продолжение темы). Надо чтобы при печати строки с объединёнными ячейками не "рвались", а при невозможности печати строки целиком, печаталась бы на следующем листе. Вроде объяснил не очень. Прилагаю скрины. Это как получается:
Доброго времени суток Форумчане. Помогите пожалуйста доработать макрос (это продолжение темы). Надо чтобы при печати строки с объединёнными ячейками не "рвались", а при невозможности печати строки целиком, печаталась бы на следующем листе. Вроде объяснил не очень. Прилагаю скрины. Это как получается:DrMini
Я так понимаю что нужен аналог вордовскому "Allow row break across pages", только нет такого встроенного. Ну гипотетически пробежаться по PageBreaks и если строка рвет объединенную ячейку (а это означает что надо проверить все строку на принадлежность такой), то поставить разрыв на начало этого объединения.
Я так понимаю что нужен аналог вордовскому "Allow row break across pages", только нет такого встроенного. Ну гипотетически пробежаться по PageBreaks и если строка рвет объединенную ячейку (а это означает что надо проверить все строку на принадлежность такой), то поставить разрыв на начало этого объединения.bmv98rus
Замечательный Временно просто медведь , процентов на 20.
опишите задачу и приложите пример в файле, чтобы не приходилось перечитывать предыдущую тему на трёх листах
Прошу прощения. Тропился на обед. Предыдущий материал можно и не читать. Задачу описал выше. Может коряво но я даже не знаю, как это охарактеризовать. bmv98rusнаверное более правильно описал, чем я. Вот заполненный файл:
опишите задачу и приложите пример в файле, чтобы не приходилось перечитывать предыдущую тему на трёх листах
Прошу прощения. Тропился на обед. Предыдущий материал можно и не читать. Задачу описал выше. Может коряво но я даже не знаю, как это охарактеризовать. bmv98rusнаверное более правильно описал, чем я. Вот заполненный файл:DrMini
Андрей, применительно к конкретному примеру - да, а вот если объединения со смещением , то нужно искать ячейку объединенную с минимальным индексом строки.
Андрей, применительно к конкретному примеру - да, а вот если объединения со смещением , то нужно искать ячейку объединенную с минимальным индексом строки.
Sub page_breaks() Dim ilr As Integer, pbrow As Integer With ActiveSheet ilr = .Cells(.Rows.Count, 5).End(xlUp).Row pbrow = 50 Do While ilr > pbrow pbrow = .Cells(pbrow, 1).MergeArea.Cells(1).Row .HPageBreaks.Add Before:=.Cells(pbrow, 6) pbrow = pbrow + 50 Loop End With End Sub
[/vba] upd. изменил, файл перевложил
Добрый день. Примерно так [vba]
Код
Sub page_breaks() Dim ilr As Integer, pbrow As Integer With ActiveSheet ilr = .Cells(.Rows.Count, 5).End(xlUp).Row pbrow = 50 Do While ilr > pbrow pbrow = .Cells(pbrow, 1).MergeArea.Cells(1).Row .HPageBreaks.Add Before:=.Cells(pbrow, 6) pbrow = pbrow + 50 Loop End With End Sub
sboy, Работает не совсем корректно. Наверное Вы не заметили, что есть строки из 5-ти и 4-ёх объединённых строк. Моё упущение. Не объяснил. Прошу прощения. В дальнейшем могут быть строки из 2-ух объединённых строк в одну.
sboy, Работает не совсем корректно. Наверное Вы не заметили, что есть строки из 5-ти и 4-ёх объединённых строк. Моё упущение. Не объяснил. Прошу прощения. В дальнейшем могут быть строки из 2-ух объединённых строк в одну.DrMini
Sub myPageSetup() Dim i&, x& '10 On Error Resume Next Application.ScreenUpdating = False ActiveWindow.View = xlPageBreakPreview With ActiveSheet .ResetAllPageBreaks i = 1 Do While i <= .HPageBreaks.Count x = .HPageBreaks(i).Location.Row If .Cells(x, 1).MergeCells Then Set .HPageBreaks(i).Location = .Cells(x, 1).MergeArea(1) End If i = i + 1 DoEvents Loop End With Application.ScreenUpdating = True End Sub
[/vba]
[vba]
Код
Sub myPageSetup() Dim i&, x& '10 On Error Resume Next Application.ScreenUpdating = False ActiveWindow.View = xlPageBreakPreview With ActiveSheet .ResetAllPageBreaks i = 1 Do While i <= .HPageBreaks.Count x = .HPageBreaks(i).Location.Row If .Cells(x, 1).MergeCells Then Set .HPageBreaks(i).Location = .Cells(x, 1).MergeArea(1) End If i = i + 1 DoEvents Loop End With Application.ScreenUpdating = True End Sub
Sub myPageSetup() Dim x&, PB As Object '10 On Error Resume Next Application.ScreenUpdating = False ActiveWindow.View = xlPageBreakPreview With ActiveSheet .ResetAllPageBreaks For Each PB In .HPageBreaks x = PB.Location.Row If .Cells(x, 1).MergeCells Then Set PB.Location = .Cells(x, 1).MergeArea(1) End If DoEvents Next End With Application.ScreenUpdating = True End Sub
[/vba]
, чуть не забыл, все работает.
RAN, Андрей, ну что за нелюбовь к For Each? [vba]
Код
Sub myPageSetup() Dim x&, PB As Object '10 On Error Resume Next Application.ScreenUpdating = False ActiveWindow.View = xlPageBreakPreview With ActiveSheet .ResetAllPageBreaks For Each PB In .HPageBreaks x = PB.Location.Row If .Cells(x, 1).MergeCells Then Set PB.Location = .Cells(x, 1).MergeArea(1) End If DoEvents Next End With Application.ScreenUpdating = True End Sub