У меня есть таблица, она огромная. Её нужно распечатать. На обычный лист А4 она не помещается. Настроила поля, но граница (где заканчивается лист А4) не захватывает полностью ячейку моей таблицы, получается разрыв. Его можно отрегулировать в ручную, но каждый раз подтягивать к "границе" ячейки, которых от 3500 шт, очень долго и мучительно. Как быть? Есть ли чудо-кнопка у моей проблемы?
У меня есть таблица, она огромная. Её нужно распечатать. На обычный лист А4 она не помещается. Настроила поля, но граница (где заканчивается лист А4) не захватывает полностью ячейку моей таблицы, получается разрыв. Его можно отрегулировать в ручную, но каждый раз подтягивать к "границе" ячейки, которых от 3500 шт, очень долго и мучительно. Как быть? Есть ли чудо-кнопка у моей проблемы?
Sub PageBreak() Application.ScreenUpdating = 0: Application.EnableEvents = 0 Dim F&, L&, I&, J&, K&, S$
With ActiveSheet.UsedRange F = .Column L = .Column + .Columns.Count - 1 End With
Do While I < ActiveSheet.HPageBreaks.Count I = I + 1 J = ActiveSheet.HPageBreaks(I).Location.Row For K = F To L If Cells(J, K).MergeCells And Cells(J - 1, K).MergeCells Then If Cells(J, K).MergeArea.Address = Cells(J - 1, K).MergeArea.Address _ And S <> Cells(J, K).MergeArea.Address Then S = Cells(J, K).MergeArea.Address Set ActiveSheet.HPageBreaks(I).Location = Cells(J, K).MergeArea.Offset(1) End If End If Next Loop Application.ScreenUpdating = 1: Application.EnableEvents = 1 End Sub
[/vba]
имхо вопрос по части VBA [vba]
Код
Sub PageBreak() Application.ScreenUpdating = 0: Application.EnableEvents = 0 Dim F&, L&, I&, J&, K&, S$
With ActiveSheet.UsedRange F = .Column L = .Column + .Columns.Count - 1 End With
Do While I < ActiveSheet.HPageBreaks.Count I = I + 1 J = ActiveSheet.HPageBreaks(I).Location.Row For K = F To L If Cells(J, K).MergeCells And Cells(J - 1, K).MergeCells Then If Cells(J, K).MergeArea.Address = Cells(J - 1, K).MergeArea.Address _ And S <> Cells(J, K).MergeArea.Address Then S = Cells(J, K).MergeArea.Address Set ActiveSheet.HPageBreaks(I).Location = Cells(J, K).MergeArea.Offset(1) End If End If Next Loop Application.ScreenUpdating = 1: Application.EnableEvents = 1 End Sub