Страницы: 1
RSS
Автоматическое добавление строки "Всего по странице"
 
Задал вопрос в ветке вопросов. Но рвения помочь допилить не обнаружилось. Поэтому дублирую вопрос тут. Готов оплатить труд. Срок до 7 дней. Файл приложен в виде заготовки. Поэтому при внедрении в рабочий файл возможно потребуется подкорректировать код под реальные условия.

Нашел в интернете макрос, который почти идеально подходит для решения задачи. Но поскольку VBA я не владею, то допилить код до идеала сам не могу. Суть того, что хотелось бы получить на итог при исполнении макроса:
- Автоматическое добавление строки с промежуточным итогом. Суммироваться должен столбец "G" - сделано
- Вместе с добавлением этой строки в столбце "H" должно появляться слово "ИСТИНА"
- Текст в столбце "D" должке быть "Итого без НДС" вместо "Итого по странице" - сделано
- Текст в столбце "F" должке быть "х" (типо просто крестик))))
- В этом макросе суммируются еще другие столбцы, мне они не нужны. Нужен только один столбец "G" - сделано
- В этом макросе на последней странице еще добавляется строка "Всего приход". Мне нужно вместо нее три строки с текстом в столбце "D"
               a. "Всего по акту без учета НДС" - которая будет отображать сумму всего столбца "G" без учета промежуточных итогов на каждом листе.
               b. "НДС" c формулой =ОКРУГЛ(строка "a"*0,2;2)
               c. Всего по акту с учётом НДС  c формулой сумма двух предыдущих
Причем эти три строки должны появиться сразу после таблицы, поскольку ниже нее идут еще данные (фамилии, должности и т.д)
- Очень нужно оставить возможность удалить сделанные строки

Код
Option Explicit

Const FIRST_ROW& = 10
Const FIRST_COL$ = "G"
Const LAST_COL$ = "G"
Const ITOGO_COL$ = "D"

Sub CreatePageSubtotals()
Dim iPageNum&, viewState, hpb As HPageBreak, iRow1&, iRow2&

viewState = ActiveWindow.View
ActiveWindow.View = xlPageBreakPreview
iRow1 = FIRST_ROW
For Each hpb In ActiveSheet.HPageBreaks
    iRow2 = hpb.Location.Row - 1
    Rows(iRow2).Insert
    Cells(iRow2, ITOGO_COL) = "Итого без НДС"
    Range(Cells(iRow2, FIRST_COL), Cells(iRow2, LAST_COL)).FormulaR1C1 = _
        "=SUBTOTAL(9,R[" & iRow1 - iRow2 & "]C:R[-1]C)"
    Rows(iRow2).Font.Bold = True
    iRow1 = iRow2 + 1
Next

iRow2 = Cells(Rows.Count, FIRST_COL).End(xlUp).Row + 1
Cells(iRow2, ITOGO_COL) = "Итого без НДС"

With Range(Cells(iRow2, FIRST_COL), Cells(iRow2, LAST_COL))
    .FormulaR1C1 = "=SUBTOTAL(9,R[" & iRow1 - iRow2 & "]C:R[-1]C)"
    .NumberFormat = "0.00"
End With

Range(iRow2 & ":" & iRow2 + 1).Font.Bold = True
iRow2 = iRow2 + 1
Cells(iRow2, ITOGO_COL) = "Всего по акту без учета НДС"
With Range(Cells(iRow2, FIRST_COL), Cells(iRow2, LAST_COL))
    .FormulaR1C1 = "=SUBTOTAL(9,R[" & FIRST_ROW - iRow2 & "]C:R[-1]C)"
    .NumberFormat = "0.00"
End With

Range(iRow2 & ":" & iRow2 + 1).Font.Bold = True
iRow2 = iRow2 + 1
Cells(iRow2, ITOGO_COL) = "НДС"
With Range(Cells(iRow2, FIRST_COL), Cells(iRow2, LAST_COL))
    .FormulaR1C1 = "=SUBTOTAL(9,R[" & FIRST_ROW - iRow2 & "]C:R[-1]C)"
    .NumberFormat = "0.00"
End With

Range(iRow2 & ":" & iRow2 + 1).Font.Bold = True
iRow2 = iRow2 + 1
Cells(iRow2, ITOGO_COL) = "Всего по акту с учётом НДС
With Range(Cells(iRow2, FIRST_COL), Cells(iRow2, LAST_COL))
    .FormulaR1C1 = "=SUBTOTAL(9,R[" & FIRST_ROW - iRow2 & "]C:R[-1]C)"
    .NumberFormat = "0.00"
End With

ActiveWindow.View = viewState
'Всего приход:
End Sub

Sub RemovePageSubtotals()
On Error Resume Next
Cells(FIRST_ROW, FIRST_COL).RemoveSubtotal
End Sub
 
Пишу в личку.
 
Файл-пример
 
Линии границ таблицы
Страницы: 1
Наверх