Страницы: 1
RSS
Макрос печати по условию
 
Здравствуйте!
Строка из цикла по листам книги:
Если первая ячейка на очередном листе Ws поименована как "first", то - печатать.
Почему не работает?
Код
Dim Ws As Worksheet
.... 
If Ws.Cells(1, 1).Name = "first" Then Ws.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Изменено: MrBrown - 19.04.2019 09:50:45
 
Файл-пример приложите
Согласие есть продукт при полном непротивлении сторон
 
Код
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?
Сейчас попробую....  
Изменено: MrBrown - 19.04.2019 10:04:30
 
Код
If Ws.Cells(1, 1).Name.Name = "first" then ......
Согласие есть продукт при полном непротивлении сторон
 
Так печатает только последний лист с поименованной ячейкой.
 
Поставил условие в начало цикла.
Код
For Each Ws In wb.Worksheets
If Ws.Cells(1, 1).Name = "first" Then
Печатает правильно, но в конце появляется окно отладки макроса.

 
Цитата
Sanja написал: Файл-пример приложите
Согласие есть продукт при полном непротивлении сторон
 
Как-то так...
 
А зачем такие сложности с именованными ячейками? У Вас возможен конфликт имен, т.к. области действия одного и того-же имени разные. есть 'first' с областью действия вся книга, а есть такое же имя с областью лист. Может просто в эту ячейку вписывать какой-то признак (можно шрифтом белого цвета)? Или печатать/не печатать листы с конкретными именами самих листов?
Согласие есть продукт при полном непротивлении сторон
 
А можно, наверное, вообще исключить имя первой ячейки?
Просто задавать диапазон печати от Cells(1,1) до ячейки с Name="MEM".
p.s. "first" на книгу я не ставил. Как-то само проставилось.
Изменено: MrBrown - 19.04.2019 11:13:05
 
Цитата
MrBrown написал: я не ставил. Как-то само
Конечно 'само'  :D потому что, по-умолчанию, Excel предлагает область 'Вся книга', а Вы наверное, просто Ок нажали
Согласие есть продукт при полном непротивлении сторон
 
Цитата
MrBrown написал:
Просто задавать диапазон печати от Cells(1,1) до ячейки с Name="MEM".
Ну вот опять. Ваш 'MEM' на разных листах в разном месте находится? Почему нельзя конкретный адрес указать?
Согласие есть продукт при полном непротивлении сторон
 
И как теперь убрать из книги, оставив только на листах?
Может из-за этого и не работает.
 
Цитата
MrBrown написал: И как теперь убрать из книги, оставив только на листах?
Только удалить и назначить снова, но это продолжение хождения по граблям и одевание трусов через голову одновременно
Согласие есть продукт при полном непротивлении сторон
 
Мда, трусы с граблями - это не вариант.

Посоветуйте, как сделать.
Задача простая:

печатать всё внутри чертёжной форматки.
Левый верхний угол - первая ячейка.
В нижнем правом углу всегда стоит "МЭМ". Но лучше этот угол форматки определить как-то по-иному: мало ли, наименование фирмы поменяется.

И не печатать то, что в ячейках вне форматок (для проверки проставлены несколько цифирь).
И не печатать другие листы, где нет форматок (для проверки вставлен лист "остекление").

Как-то так...

p.s. да, ещё: количество строк и столбцов, в зависимости от контента, может меняться.
Поэтому нижний правый угол форматки нельзя привязывать к конкретным ячейкам.
Изменено: MrBrown - 19.04.2019 11:29:28
 
Цитата
Сори, не дочитал Ваше последнее сообщение
Изменено: Sanja - 19.04.2019 11:40:42
Согласие есть продукт при полном непротивлении сторон
 
Убрал именованную ячейку "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, Благодарю. Работает.
Ну, с отслеживанием добавлений новых листов, не предназначенных к печати, можно смириться: разок добавил в макрос и забыл.
Спасибо!
______________________
ан, не работает.
при перемещении листа "остекление" между печатаемыми листами, макрос печатает только первые листы, которые до "остекления".
Ну, это, наверное, уже другая задача.
Спасибо.
Изменено: MrBrown - 19.04.2019 12:38:36
 
Не-а, не удобно. Я сделал по-другому: скрыл базы данных ("остекление) и заставил макрос при печати выбирать только видимые листы:
Код
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
Вот теперь - годится!
Изменено: MrBrown - 19.04.2019 16:34:16
 
Цитата
MrBrown написал: Вот теперь - годится!
А как же быть с 'MEM'? Вы же сами написали
Цитата
MrBrown написал: Но лучше этот угол форматки определить как-то по-иному: мало ли, наименование фирмы поменяется.
Хотя, дело хозяйское, годится так годится
Согласие есть продукт при полном непротивлении сторон
Страницы: 1
Наверх