Sub Print_Area()
Dim wb As Workbook: Set wb = ActiveWorkbook
Dim Ws As Worksheet
Dim Ma, rngEnd As Range
Application.ScreenUpdating = False
For Each Ws In wb.Worksheets
Set Ma = Range("MEM").MergeArea
Set rngEnd = Ma.Cells(Ma.Rows.Count, Ma.Columns.Count)
ActiveSheet.PageSetup.PrintArea = Range("first", rngEnd).Address
If Ws.Cells(1, 1).Name = "first" Then Ws.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Next
Application.ScreenUpdating = True
End Sub
Пожалуйста: Макрос в цикле устанавливает на листах область печати, ограниченную самой первой ячейкой ("first") и нижней правой ("MEM"). А печатать не желает. То есть если без условия If-Then, то печатает, но вообще все листы, а мне надо только те, у которых есть "first". ____________________ p.s. а, может быть, сделать условие существования поименованной ячейки, типа exist? Сейчас попробую....
А зачем такие сложности с именованными ячейками? У Вас возможен конфликт имен, т.к. области действия одного и того-же имени разные. есть 'first' с областью действия вся книга, а есть такое же имя с областью лист. Может просто в эту ячейку вписывать какой-то признак (можно шрифтом белого цвета)? Или печатать/не печатать листы с конкретными именами самих листов?
Согласие есть продукт при полном непротивлении сторон
А можно, наверное, вообще исключить имя первой ячейки? Просто задавать диапазон печати от Cells(1,1) до ячейки с Name="MEM". p.s. "first" на книгу я не ставил. Как-то само проставилось.
печатать всё внутри чертёжной форматки. Левый верхний угол - первая ячейка. В нижнем правом углу всегда стоит "МЭМ". Но лучше этот угол форматки определить как-то по-иному: мало ли, наименование фирмы поменяется.
И не печатать то, что в ячейках вне форматок (для проверки проставлены несколько цифирь). И не печатать другие листы, где нет форматок (для проверки вставлен лист "остекление").
Как-то так...
p.s. да, ещё: количество строк и столбцов, в зависимости от контента, может меняться. Поэтому нижний правый угол форматки нельзя привязывать к конкретным ячейкам.
Убрал именованную ячейку "first". Осталось сформировать условие наличия на листе ячейки "МЭМ":
Код
Sub Print_Area()
Dim wb As Workbook: Set wb = ActiveWorkbook
Dim Ws As Worksheet
Dim Ma, rngEnd As Range
Application.ScreenUpdating = False
For Each Ws In wb.Worksheets
Set Ma = Range("MEM").MergeArea
'MsgBox Ma.Address
Set rngEnd = Ma.Cells(Ma.Rows.Count, Ma.Columns.Count)
'MsgBox rngEnd.Address
ActiveSheet.PageSetup.PrintArea = Range("A1", rngEnd).Address
'If (условие наличия на листе ячейки с именем "MEM" или содержанием "МЭМ") Then
'Ws.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
' End If
Next
Application.ScreenUpdating = True
End Sub
Sub Print_Shets()
Dim Ws As Worksheet
Dim Ma, rngEnd As Range
Dim arr(), dic As Object, iTemp
Dim I&, iRow&, iClmn&
'массив имен листов, которые печатать НЕ нужно
arr = Array("Остекление", "Остекление-1", "Остекление-2", "Покрытие-1")
'заносим эти имена в Словарь
Set dic = CreateObject("Scripting.Dictionary")
For I = LBound(arr) To UBound(arr): iTemp = dic(arr(I)): Next
Application.ScreenUpdating = False
'цикл по всем листам книги
For Each Ws In ThisWorkbook.Worksheets
If Not dic.Exists(Ws.Name) Then 'если имени листа НЕТ в Словаре, то печатаем его
With Ws
'находим строку с текстом '№ докум.', она будет последней строкой в Области печати
iRow = .Cells.Find("№ докум.").Row
'находим столбец с данными на две строки выше найденной и на один столбец правее, т.к. строки объединены
iClmn = .Cells(iRow - 2, .Columns.Count).End(xlToLeft).Column + 1
'устанавливаем Область печати для этого листа
.PageSetup.PrintArea = (.Range(.Cells(1, 1), .Cells(iRow, iClmn)).Address)
'печатаем лист
.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End With
End If
Next
Application.ScreenUpdating = True
End Sub
Согласие есть продукт при полном непротивлении сторон
Sanja, Благодарю. Работает. Ну, с отслеживанием добавлений новых листов, не предназначенных к печати, можно смириться: разок добавил в макрос и забыл. Спасибо! ______________________ ан, не работает. при перемещении листа "остекление" между печатаемыми листами, макрос печатает только первые листы, которые до "остекления". Ну, это, наверное, уже другая задача. Спасибо.
Не-а, не удобно. Я сделал по-другому: скрыл базы данных ("остекление) и заставил макрос при печати выбирать только видимые листы:
Код
Sub Print_Area()
Dim wb As Workbook: Set wb = ActiveWorkbook
Dim Ws As Worksheet
Dim Ma, rngEnd As Range
Application.ScreenUpdating = False
For Each Ws In wb.Worksheets
Set Ma = Range("MEM").MergeArea
'MsgBox Ma.Address
Set rngEnd = Ma.Cells(Ma.Rows.Count, Ma.Columns.Count)
'MsgBox rngEnd.Address
ActiveSheet.PageSetup.PrintArea = Range("A1", rngEnd).Address
If Ws.Visible = xlSheetVisible Then
Ws.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End If
Next
Application.ScreenUpdating = True
End Sub