Если исходить из предположения, что каждый новый документ (кроме самого первого, естественно) обязательно имеет перед своей первой строкой принудительно вставленный разрыв страницы, то можно попробовать следующую идею.
Принтер должен быть сразу установлен в дуплекс.
Далее макросом.
1. Пробежать по всем HpageBreaks и вычленить из них те, что вставлены вручную.
2. Распечатывать каждый документ отдельно, а именно только то, что находится между ручными HpageBreaks. Это можно сделать двумя способами:
А) Скрывать прочие строки, оставляя видимыми только строки очередного нужного документа.
Б) Задавая каждый раз область печати в виде области текущего документа.
Далее представлены оба кода.
Способ А
Код: Выделить всё
Sub DuplPrn_HiddRows()
Dim MHPBR(1 To 65536, 1 To 2) As Variant
Dim CurScrlR, LastRow
Dim N, m, i
Application.ScreenUpdating = True
CurScrlR = ActiveWindow.ScrollRow
LastRow = ActiveSheet.UsedRange.Rows(1).Row + ActiveSheet.UsedRange.Rows.Count - 1
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollRow = LastRow
ActiveWindow.ScrollRow = CurScrlR
N = ActiveSheet.HPageBreaks.Count
m = 0
For i = 1 To N
If ActiveSheet.HPageBreaks(i).Type = xlPageBreakManual Then
m = m + 1
MHPBR(m, 1) = ActiveSheet.HPageBreaks(i).Location.Row
MHPBR(m, 2) = i
End If
Next
If m > 0 Then
For i = m To 1 Step -1
CurScrlR = ActiveWindow.ScrollRow
LastRow = ActiveSheet.UsedRange.Rows(1).Row + ActiveSheet.UsedRange.Rows.Count - 1
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollRow = LastRow
ActiveWindow.ScrollRow = CurScrlR
N = ActiveSheet.HPageBreaks.Count
ActiveSheet.HPageBreaks(MHPBR(i, 2)).Delete
Next
For i = 1 To m + 1
If i = 1 Then
Range(MHPBR(i, 1) & ":65536").EntireRow.Hidden = True
ElseIf i = m + 1 Then
Range("1:" & MHPBR(i - 1, 1) - 1).EntireRow.Hidden = True
Else
Range("1:" & MHPBR(i - 1, 1) - 1 & "," & MHPBR(i, 1) & ":65536").EntireRow.Hidden = True
End If
ActiveSheet.PrintOut
Cells.EntireRow.Hidden = False
Next
For i = m To 1 Step -1
ActiveSheet.HPageBreaks.Add Cells(MHPBR(i, 1), 1)
Next
Else
ActiveSheet.PrintOut
End If
End Sub
Способ Б
Код: Выделить всё
Sub DuplPrn_PrnArea()
Dim MHPBR(1 To 65536, 1 To 2) As Variant
Dim CurScrlR, LastRow
Dim N, m, i
CurScrlR = ActiveWindow.ScrollRow
LastRow = ActiveSheet.UsedRange.Rows(1).Row + ActiveSheet.UsedRange.Rows.Count - 1
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollRow = LastRow
ActiveWindow.ScrollRow = CurScrlR
N = ActiveSheet.HPageBreaks.Count
m = 0
For i = 1 To N
If ActiveSheet.HPageBreaks(i).Type = xlPageBreakManual Then
m = m + 1
MHPBR(m, 1) = ActiveSheet.HPageBreaks(i).Location.Row
MHPBR(m, 2) = i
End If
Next
If m > 0 Then
For i = 1 To m + 1
If i = 1 Then
ActiveSheet.PageSetup.PrintArea = "1:" & MHPBR(i, 1) - 1
ElseIf i = m + 1 Then
' ! ! ! ! Может быть некорретно задана область печати ! ! !
ActiveSheet.PageSetup.PrintArea = MHPBR(m, 1) & ":" & LastRow
Else
ActiveSheet.PageSetup.PrintArea = MHPBR(i - 1, 1) & ":" & MHPBR(i, 1) - 1
End If
ActiveSheet.PrintOut
Next
ActiveSheet.PageSetup.PrintArea = ""
Else
ActiveSheet.PrintOut
End If
End Sub
Замечания по способу А.
Неимоверная глючность HpageBreaks. Часть кода и есть попытка борьбы с непредсказуемостью и непостоянностью работы HpageBreaks. А именно:
и
Код: Выделить всё
CurScrlR = ActiveWindow.ScrollRow
LastRow = ActiveSheet.UsedRange.Rows(1).Row + ActiveSheet.UsedRange.Rows.Count - 1
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollRow = LastRow
ActiveWindow.ScrollRow = CurScrlR
и даже в этом случае иногда на строке с HpageBreaks(i) выскакивает ошибка выполнения '9', хотя явно индекс не выходит за пределы допустимого диапазона.
Если у кого есть способ решения этой проблемки, то расскажите.
Замечания по способу Б
Для последнего документа не смог точно определить последней страницы печати. Методы
Код: Выделить всё
LastRow=ActiveSheet.UsedRange.Rows(1).Row+ActiveSheet.UsedRange.Rows.Count-1
и
Код: Выделить всё
lLastRow = ActiveCell.SpecialCells(xlLastCell).Row
Do While Application.CountA(Rows(lLastRow)) = 0 And lLastRow > 0
lLastRow = lLastRow - 1
Loop
не дают однозначно номер последнего столбца, который будет именно распечатываться, т.к. UsedRange даёт значение всей используемой области (напр., если изменён формат ячейки - шрифт, но в ней нет данных, то они не будут выводиться на печать), а SpecialCells(xlLastCell) даёт последнюю ячейку с данными (а если ниже есть, напр., закрашенная ячейка, то она выведется на печать). Т. е. с UsedRange последний документ может распечатываться с лишними пустыми страницами, а с SpecialCells(xlLastCell) может в конце не распечататься какая-нибудь закрашенная или обрамлённая ячейка.
Так что по этой проблемке тоже, может быть, у кого-то есть соображения.
