Почему не получается регулировать отсчитываемое количество строк перед подведением итого?

Question

[Сергей]

Добрый день, помогите найти ошибку, не могу понять почему только 1 раз отсчитывается 14 строк, а потом строго по 18 каждый раз до конца данных в таблице.
Скрипт подставляет в конце каждой страницы пустую строку где высчитывает итого по 13 и 15 столбцам таблицы.

Скрипт

Sub Print_Title()
    Dim a%, b&, d&, e, n&
    e = ActiveSheet.PageSetup.PrintTitleRows    'Select '.Count '= "$1:$7"
    e = Range(e).Rows.Count
    ActiveSheet.Copy Before:=Sheets(2)
    ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
    ActiveSheet.DrawingObjects(1).Text = "Print"
    ActiveSheet.DrawingObjects(1).OnAction = "KuklP"
    a = ActiveSheet.HPageBreaks(1).Location.Row
    b = Cells(Rows.Count, 1).End(xlUp).Row
    d = a: n = 14 ' первый раз отсчитвваем 14 строк и подбиваем итого (дальше почему то подбивается только после 18 строки)
    While d < b
        Rows(d - 2).Insert ' пустая строка
        Rows(d - 2).Insert ' пустая строка в которую происходит запись
        Cells(d - 1, 12).Value = "ИТОГО" ' пишем в 12 колонку слово Итого
        Cells(d - 1, 13).Formula = "=SUM(" & Range(Cells(n, 13), Cells(d - 3, 13)).Address(0, 0) & ")" ' подсчет суммы в 13 колонке
        Cells(d - 1, 15).Formula = "=SUM(" & Range(Cells(n, 15), Cells(d - 3, 15)).Address(0, 0) & ")" ' подсчет суммы в 15 колонке
        Cells(d - 1, 13).AutoFill Range(Cells(d - 1, 13), Cells(d - 1, 16)), 0 ' записываем подсчитаное в стоке
        n = d
        d = a + d - e + 4
        b = Cells(Rows.Count, 1).End(xlUp).Row + 2
    Wend
        Rows(d - 2).Insert ' пустая строка
        Rows(d - 2).Insert ' пустая строка в которую происходит запись
        Cells(d - 1, 12).Value = "ИТОГО" ' пишем в 12 колонку слово Итого
        Cells(d - 1, 13).Formula = "=SUM(" & Range(Cells(n, 13), Cells(d - 3, 13)).Address(0, 0) & ")" ' подсчет суммы в 13 колонке
        Cells(d - 1, 15).Formula = "=SUM(" & Range(Cells(n, 15), Cells(d - 3, 15)).Address(0, 0) & ")" ' подсчет суммы в 15 колонке
        Cells(d - 1, 13).AutoFill Range(Cells(d - 1, 13), Cells(d - 1, 16)), 0 ' записываем подсчитаное в стоке
        'Cells(b, 12).Value = "ИТОГО"
        'Cells(b, 13).Formula = "=SUM(" & Range(Cells(n, 13), Cells(b - 2, 13)).Address(0, 0) & ")"
        'Cells(b, 15).Formula = "=SUM(" & Range(Cells(n, 15), Cells(b - 2, 15)).Address(0, 0) & ")"
        'Cells(b, 13).AutoFill Range(Cells(b, 13), Cells(b, 16)), 0
End Sub

Comments

[DS28]

Сходу код не запустился

Очевидно, если расчёт завязан на n = 14, то не нужно делать n = d

Поставьте msgbox n
после разных действий, посмотрите где подмена...

[Сергей]

DS28,
Msgbox показывается n = 14 (заданному) на всех этапах цикла, но на кол-во строк после 1 раза это никак не влияет.

[h8nor]

Сходу и не запустится: лист привязан к сквозным строкам PrintTitleRows, есть картинки DrawingObjects(1), зачем-то сделали привязку к разделителям HPageBreaks(1) (не известно на каких строках они висят), последняя строка b ищется в лоб, хотя для этого есть метод SpecialCells(xlLastCell), дальше в цикле формула Formula = "=SUM(" непонятное дублирование и методы (без комментариев), в цикле запутывание значений переменных.
Выкиньте переменную n из кода и смотрите в цикле переменную d.

[DS28]

Сергей, а d какие значения принимает?

[Сергей]

DS28, d = 49 и не важно убрал ли я из формулы переменную n или нет.

[Сергей]

Дѣаволъ,

lLastRow = Cells.SpecialCells(xlLastCell).Row 'находим самую нижнюю заполненную строку
MsgBox (lLastRow) 'отображает самую нижнюю заполненную строчку

Как найти последнюю строку на странице? (таблица к примеру печатается на 5 страницах)

[h8nor]

Сергей, это плохая практика привязываться к печатным страницам. Размер области печати может меняться не только из-за Параметров страницы, но и настроек/модели принтера.

[DS28]

Сергей, может книгу выложите?

[Сергей]

DS28, ссылка на книгу

[Сергей]

Дѣаволъ, есть ли способ реализации разделения на страницы при плавающей ширине строки?

[h8nor]

Сергей, я занимался этим вопросом некоторое время и пересмотрел различные настройки Параметров страниц. Тривиального решения за выделенное себе время я не нашёл (из-за десятка вариаций, влияющих на область печати и зависимости относительных значений одних параметров от других).
Давайте лучше вернёмся к вашему вопросу по коду.

[DS28]

Сергей, увы, дома у меня libre и я до понедельника ушёл в отпуск...

[Сергей]

Шапка документа 16 столбцов 2 строки + 1 строка с нумерацией 1..16 столбцов.

Код

Sub vbc()

    ActiveSheet.Copy After:=Sheets(1)  'Копируем всё на новый лист, следующий после 1го листа.
    ActiveSheet.PageSetup.Orientation = xlLandscape  'Изменяем формат на альбомный
   
    With ActiveSheet.PageSetup 'Поместить все строки и столбцы на 1 страницу, но когда много строк то 
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 100
    End With
    ActiveWindow.View = xlPageLayoutView
    ActiveWindow.View = xlPageBreakPreview
   
End Sub

Как получить номер последней строки с текстом на странице?

lLastRow = Cells.SpecialCells(xlLastCell).Row 'Получаем номер последней строки с текстом на листе

Номер страницы с выделенным полем (клеткой)

Public Sub PageNumner()
    Dim VPB As Excel.VPageBreak
    Dim HPB As Excel.HPageBreak
    Dim intVPBC As Integer
    Dim intHPPC As Integer
    Dim lngPage As Long
    
    lngPage = 1
    
    If ActiveSheet.PageSetup.Order = xlDownThenOver Then
        intHPPC = ActiveSheet.HPageBreaks.Count + 1
        intVPBC = 1
    Else
        intVPBC = ActiveSheet.VPageBreaks.Count + 1
        intHPPC = 1
    End If

    For Each VPB In ActiveSheet.VPageBreaks
        If VPB.Location.Column > ActiveCell.Column Then
            Exit For
        End If
        
        lngPage = lngPage + intHPPC
    Next VPB
    
    For Each HPB In ActiveSheet.HPageBreaks
        If HPB.Location.Row > ActiveCell.Row Then
            Exit For
        End If
            
        lngPage = lngPage + intVPBC
    Next HPB
    
    MsgBox "Íîìåð ñòðàíèöû àêòèâíîé ÿ÷åéêè = " & lngPage
End Sub