Страницы: 1
RSS
Изменить высоту ячеек определенного диапазона, в зависимости от содержания последней страницы печати
 
Здравствуйте, уже 2ой день мучаюсь написать макрос, который бы увеличивал высоту ячеек определенного диапазона, если последняя строка этого диапазона, не находится на одной странице печати что и последняя строка активного листа.
Вначале я задаю параметры печати, потом вычислял последнюю строку нужного мне диапазана, последнюю строку всего листа, и страницы на котоых эти строки находятся, потом сравнивал эти номера страниц. Если эти строки нахядятся на одном листе печати, то ничего не делать, все хорошо. А если на разных, следовательно нужно увеличивать на 1 единицу высоту ячеек заданого диапазона до тех пор, пока в результате, на последней странице печати, будет как минимум последняя строка определенного диапазона.

Прилагаю наглядные скрины и код.
У меня зацикливается выполнение кода, не понимаю что делать. Вот код, я новичек в написании макросов, и плохо понимаю алгоритмы, но вот что у меня получилось:
Код
Sub формат_печати_последней_страницы()

Dim numAllPages As Long
Dim lastRowDiap As Long
Dim lastRowSheet As Long
Dim numlastRowDiapPage As Long
Dim numlastRowSheetPage As Long

' задать параметры печати
With Worksheets(1).PageSetup
 .LeftMargin = Application.InchesToPoints(0)
 .RightMargin = Application.InchesToPoints(0)
 .TopMargin = Application.InchesToPoints(0)
 .BottomMargin = Application.InchesToPoints(0)
 .HeaderMargin = Application.InchesToPoints(1.3)
 .FooterMargin = Application.InchesToPoints(1.3)
End With

With Worksheets(1).PageSetup
 .Zoom = False
 .FitToPagesWide = 1
 .FitToPagesTall = 1000
End With

' узнать количество страниц печати
ActiveWindow.View = xlPageBreakPreview
numAllPages = Worksheets(1).HPageBreaks.Count + 1


' записать номер страницы где находится последняя строка всего листа
numlastRowSheetPage = numAllPages

' узнать номер последней строки из определенного диапазона
lastRowDiap = Cells(10, 1).End(xlDown).Row

' узнать номер последней строки из всего листа
last = Cells(10, 6).End(xlDown).Row
lastRowSheet = Cells(last, 6).End(xlDown).Row

' узнать номер страницы где находится последняя строка нашего диапазона
Cells(lastRowDiap, 1).Activate
For i = 1 To ActiveSheet.HPageBreaks.Count
    If ActiveCell.Row < ActiveSheet.HPageBreaks(i).Location.Row - 1 Then Exit For
Next
numlastRowDiapPage = i

' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' условие если последние строки на разных страницах
Do Until numlastRowDiapPage = numlastRowSheetPage
lr = Cells(11, 1).End(xlDown).Row
rowHei = Range(Cells(11, 1), Cells(lr, 1)).RowHeight
rowHei = rowHei + 1

' узнать количество страниц печати
ActiveWindow.View = xlPageBreakPreview
numAllPages = Worksheets(1).HPageBreaks.Count + 1
ActiveWindow.View = xlNormalView

' записать номер страницы где находится последняя строка всего листа
numlastRowSheetPage = numAllPages

' узнать номер последней строки из определенного диапазона
lastRowDiap = Cells(10, 1).End(xlDown).Row

' узнать номер последней строки из всего листа
last = Cells(10, 6).End(xlDown).Row
lastRowSheet = Cells(last, 6).End(xlDown).Row

' узнать номер страницы где находится последняя строка нашего диапазона
Cells(lastRowDiap, 1).Activate
For i = 1 To ActiveSheet.HPageBreaks.Count
    If ActiveCell.Row < ActiveSheet.HPageBreaks(i).Location.Row - 1 Then Exit For
Next
numlastRowDiapPage = i
Loop
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
ActiveWindow.View = xlNormalView
MsgBox ("Количество всех страниц: " & numAllPages & "; " & "Последняя строка в диапазоне: " & lastRowDiap & "; " & "Последняя строка на листе: " & lastRowSheet & "; " & "Номер страницы строки диапазона: " & numlastRowDiapPage & "; " & "Номер страницы последней строки: " & numlastRowSheetPage & "; ")

End Sub

Изменено: Юрий Адамец - 29.10.2020 13:48:10
Страницы: 1
Наверх