Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Автоматическая двусторонняя печать двух листов таблицы средствами VBA
 
#1
13.07.2017 15:28:41
Нашёл код для печати. Адаптировал под себя.
По отдельности листы печатаются отлично.
Но, как двустороннюю печать сделать - не представляю.
Одна моя идея: назначить двум переменным Page1 и Page2 листы, а затем присвоить их сумму третьей переменной, которую уже распечатать. Успехом она пока не увенчалась.

И теперь два вопроса:
1) Если идея с присвоением третьей переменной суммы первых двух верна, то как правильно эту сумму указать переменной?
2) Если идея не верна, то как правильно реализовать двустороннюю печать?

Принципиально важно, чтобы оба листа уходили распечатываться в дуплексе принтера.

Код
Sub PRINT_0()
    Dim i As Integer
    i = Cells(Rows.Count, "B").End(xlUp).Row
    Dim Page1, Page2, TwoPage As Object
    Set Page1 = ThisWorkbook.Sheets("ТТН_1")
    Set Page2 = ThisWorkbook.Sheets("ТТН_2")
    Set TwoPage = Page1 + Page2
    With TwoPage
        .PageSetup.Orientation = xlLandscape
        .PrintOut Copies:=2, Collate:=True, ManualDuplexPrint:=False
    End With
End Sub
 
 
 
#2
13.07.2017 15:29:57
Про двустороннюю печать было несколько (десятков) тем на форуме. ПОИСК FOREVER!
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
13.07.2017 16:06:48
Sanja,
Искал по гуглу. Много похожих тем, но моего не нашёл. Но на всякий случай поищу по форуму.
 
 
 
#4
14.07.2017 06:41:26
Цитата
Sanja написал:
Про двустороннюю печать было несколько (десятков) тем на форуме. ПОИСК FOREVER!
Почитал об этом, понял, что на офисах с 2003 по 2010 включительно двусторонняя печать проблема вселенского масштаба.
Однако, двусторонняя печать - это второе.
Первое: как вывести на печать (одностороннюю) два листа таблицы. Правильнее сказать, как назначить два листа на печать. Один назначить не трудно, вот рабочий код:
Код
Sub PRINT_0()
    Dim i As Integer
    i = Cells(Rows.Count, "B").End(xlUp).Row
    Dim Page1, Page2, TwoPage As Object
    Set Page1 = ThisWorkbook.Sheets("ТТН_1")
    Set Page2 = ThisWorkbook.Sheets("ТТН_2")
    'Set TwoPage = Page1 + Page2
    With Page1
        .PageSetup.Orientation = xlLandscape
        .PrintOut Copies:=2, Collate:=True, ManualDuplexPrint:=False
    End With
End Sub

А вот два листа как выдать разом?
Изменено: Ярослав Чикал - 14.07.2017 06:42:21
 
 
 
#5
14.07.2017 08:32:25
Код
Sheets(Array(1, 3)).PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Изменено: RAN - 14.07.2017 08:33:16
 
 
 
#6
14.07.2017 13:24:44
RAN, благодарю, это работает, =)
Код
Sub PRINT_0() 
    Sheets(Array(2, 3)).PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End Sub

Я удивлён. Оказывается, кода, чтобы распечатать надо меньше, чем я думал. Даже такой маленький код отправил задание на печать:

Код
Sub PRINT_0()
    Sheets(Array(2, 3)).PrintOut Copies:=1
End Sub

Однако, это не то.

Дело в том, что эта команда, как выделение двух листов, и их совместная печать. Эксель сначала печатает первый лист, как отдельное задание, затем второй. А если включить в свойствах печати дуплекс, то происходит странное:

Первый лист идёт на дуплекс. В первый проход при этом ничего не печатается, а лист печатается только после дуплекса. Затем идёт второй лист, но не на дуплекс, а прямиком.

Это не то. Мне нужно, чтобы два листа были соединены в одном задании, чтобы одни настройки печати применялись к обоим, и первый лист (каким бы он по счёту не был) печатался, как первый, а следующий как второй.
 
 
 
#7
14.07.2017 14:01:29
Вариант 1 (посложней)
Можно долго мучаться, вдруг (вряд-ли) да и получится.
Вариант 2 (попроще)
Создаете шаблон Word, туда макросом тащите нужное, печатаете, закрываете без сохранения.
 
 
 
#8
14.07.2017 14:15:01
Доброе время суток.
Как вариант (не тестированный).
Делаете копию установки принтера. В его настройках по умолчанию прописываете двустороннюю печать.
Для какого-то листа выбираете этот принтер (нужно получить название принтера, так как его интерпретирует Excel).
В Immediate выполняете
Код
?Application.ActivePrinter

Получаете нечто вроде "\\servername\printername (Ne03:)"
Пробуете код
Код
Sheets(Array(2, 3)).PrintOut Copies:=1, ActivePrinter:="\\servername\printername (Ne03:)"

Цитата
Ярослав Чикал написал:
Затем идёт второй лист, но не на дуплекс, а прямиком.
Это получается из-за того, что каждый лист в общем-то имеет собственные настройки печати.
 
 
 
#9
14.07.2017 14:49:58
Андрей VG, Не поможет, ибо не решена проблема объединения двух листов в одно задание печати.

Цитата
RAN написал:
Вариант 2 (попроще)
Создаете шаблон Word, туда макросом тащите нужное, печатаете, закрываете без сохранения.
Это возможно будет проделать нажатием одной кнопки?
 
 
 
#10
14.07.2017 23:46:21
Цитата
Ярослав Чикал написал:
Не поможет, ибо не решена проблема объединения двух листов в одно задание печати.
Только что проверил на домашнем принтере, который позволяет установить двустороннюю печать. Таблица Листа1 напечаталась на одной стороне, таблица Листа2 на другой. Задание печати было одно из двух страниц, скриншот прикладываю.
Похоже, коллега, либо гранаты не той системы, либо что-то кому-то мешает :)
Изменено: Андрей VG - 14.07.2017 23:50:50 (Кусочки идентификационных данных не нужны)
 
 
 
#11
15.07.2017 08:42:55
Цитата
Андрей VG написал:
Похоже, коллега, либо гранаты не той системы, либо что-то кому-то мешает
Похоже =)
Буду на работе, проверю. У меня дома принтера с дуплексом нет  :)  
 
 
 
#12
17.07.2017 15:59:24
Цитата
Андрей VG написал:
Похоже, коллега, либо гранаты не той системы, либо что-то кому-то мешает
Нет, похоже гранаты другой системы. Сделал копию принтера. Проверил имя принтера, как вы указали:
Код
?Application.ActivePrinter
Прописал в свойства этого принтера дуплекс, пустил на печать ваш образец - он мне выдал листы на дуплекс, да только перевернул не понятно как. Потом отправил мой документ - его по старинке: сперва лист с формой на дуплекс отправил, и на одной строное форму отпечатал, а на второй ничего. Затем второй лист формы отправил,  и тот пошёл без дуплекса. Два листа на одном листе опять не получились.
И если судить по картинке, в моём документе Лист1 - ТТН_1, Лист2 ТТН_2. Я также и указал, первый лист и второй:
Код
Private Sub PRN_BTN_Click()
    ThisWorkbook.Sheets(Array(1, 2)).PrintOut Copies:=1, ActivePrinter:="HP Color LaserJet CM6030 MFP [8E5E17] (Ne04:)"
End Sub
А печатал он по факту Первый лист и третий.
Проверил формулой ЛИСТ: ТТН_1 - лист2, ТТН_2 - лист3. Однако, в дуплекс отправляет по прежнему только первый из листов, и только на одну сторону, а второй без дуплекса.

Кстати, указание здесь конкретного принтера не помогло, пока я этот самый принтер не сделал по-умолчанию, что как бы не правильно.
Изменено: Ярослав Чикал - 17.07.2017 16:11:28
 
 
 
#13
17.07.2017 21:25:02
Да, похоже таки гранаты :(
 
 
 
#14
18.07.2017 08:16:19
Цитата
Андрей VG написал:
Да, похоже таки гранаты
Возможно позже, когда сделаю форму с применением UserForms получится.

А у меня другая идея. Быть может, проблема у меня из-за сложного устройства документа. Если выводить макросом на печать из нового документа, то быть может будет отправляться на дуплекс. Значит, макрос стоит дополнить копированием листов ТТН_1 и ТТН_2 в новый временный документ, чтобы распечатка выполнялась оттуда.

Вот нашёл пример:
Код
Sub copy()  
    Dim wb As Workbook  
    Set wb = Workbooks.Open("c:\temp\другая книга.xlsm", ReadOnly:=True)  
    wb.Sheets("ТТН_1").Copy before:=ThisWorkbook.Sheets(1)  
    wb.Close False  
End Sub

А вот я попытался прикрутить, но как и следовало ожидать, нужных ключей не оказалось:

Код
Private Sub PRN_BTN_Click()
    Dim wb As Workbook    
    Set wb = Workbooks.Open("c:\temp\neworkbook.xlsm", ReadOnly:=False)
    wb.Sheets(Array(2, 3)).Copy before:=ThisWorkbook.Sheets(1)
    wb.Close False
    Workbooks(wb).Sheets(Array(2, 3)).PrintOut Copies:=1, ActivePrinter:="HP Color LaserJet CM6030 MFP [8E5E17] (Ne04:)"
End Sub

Изменено: Ярослав Чикал - 18.07.2017 08:57:33
 
 
 
#15
24.07.2017 09:01:15
Сделал рабочий код, который создаёт новую книгу, добавил рабочий код, который отправляет на печать, и на выходе получил ошибку.
Что я не так сделал?
Код
Sub io()
   Dim objFSO As Object, objFile As Object
   Dim sFileName As String
   Sheets(Array(2, 3)).Copy
   With ActiveWorkbook
      .SaveAs Filename:=ThisWorkbook.Path & "\New.xlsx"
      Workbook("New.xlsx").PrintOut Copies:=1, _
      ActivePrinter:="HP Color LaserJet CM6030 MFP [8E5E17] (Ne04:)"
      .Close True
   End With
   sFileName = ThisWorkbook.Path & "\New.xlsx"
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set objFile = objFSO.GetFile(sFileName)
   objFile.Delete
End Sub
Изменено: Ярослав Чикал - 24.07.2017 09:01:35
 
 
 
#16
24.07.2017 09:13:32
Доброе время суток.
Цитата
Ярослав Чикал написал:
Workbook("New.xlsx")
У Application нет коллекции Workbook, только Workbooks ;)
 
 
 
#17
24.07.2017 12:57:16
Цитата
Андрей VG написал:
У Application нет коллекции Workbook, только Workbooks
Благодарю!
Моя идея оправдалась, теперь нормально документ выводится на двустороннюю печать, за одним исключением - второй лист перевернут (правильно для книжной ориентации). Думаю, если задать другой способ создания дуплекса (переворачивать по короткому краю), то будет то, что надо.
 
 
 
#18
24.07.2017 13:21:41
Андрей VG,
Попытался задать альбомную ориентацию, и вот что вышло
Что я не так сделал опять?
Код
Sub io()    
    ThisWorkbook.Sheets(Array(2, 3)).Copy    
    With ActiveWorkbook       
        .SaveAs Filename:=ThisWorkbook.Path & "\New.xlsx"       
        Workbooks("New.xlsx").Sheets("ТТН_1").Orientation = xlLandscape       
        Workbooks("New.xlsx").Sheets("ТТН_2").Orientation = xlLandscape       
        Workbooks("New.xlsx").Sheets(Array(1, 2)).PrintOut _       
        Copies:=1, ActivePrinter:="HP Color LaserJet CM6030 MFP [8E5E17] (Ne04:)"       
        .Close True    
    End With    
    Kill ThisWorkbook.Path & "\New.xlsx" 
End Sub

А, нашёл, пропустил я PageSetup:

Код
With Workbooks("New.xlsx")
          .Sheets(1).PageSetup.Orientation = xlLandscape
          .Sheets(2).PageSetup.Orientation = xlLandscape
      End With
Только установка альбомной ориентации не помогла - печатает по прежнему, как книжную (переворачивает по большему краю). Игрался с настройкой на принтере, Альбомную ставил с поворотом и с переворотом, Книжную ставил с поворотом и с переворотом - ничего не помогает

Какие есть идеи, как заставить переворачивать по меньшему краю? (кроме настройки принтера)
Изменено: Ярослав Чикал - 24.07.2017 14:35:09
 
 
 
#19
24.07.2017 15:41:50
ЗАРАБОТАЛО!
Оказалось, что в следствие чего-то (не знаю чего) сменилось то имя принтера, (Ne04:) сменилось на (Ne05:) из-за чего все мои махинации с настройками целевой копии принтера не могли увенчаться успехом в принципе. Кстати, и вывод на выбранный принтер стал проходить без выбора этого принтера по-умолчанию в следствие распечатки из под нового документа. Теперь этот код можно успешно применять для двусторонней печати, при двух условиях:
1) Необходимо создать копию принтера с драйверами поддерживающими двустороннюю печать (и поменять название принтера в коде);
2) В настройках печати этого принтера указать по умолчанию вывод на двустороннюю печать, и не забыть поставить правильную ориентацию.

ИТОГ:
Макрос создаёт новый документ, копирует туда выбранные листы, отправляет листы этого документа на двустороннюю печать, и сразу закрывает этот документ, и удаляет его.
Спасибо всем, кто помогал!  :D
Код
Private Sub PRN_BTN_Click()
   ThisWorkbook.Sheets(Array(2, 3)).Copy
   With ActiveWorkbook
      .SaveAs Filename:=ThisWorkbook.Path & "\New.xlsx"
      Workbooks("New.xlsx").Sheets(Array(1, 2)).PrintOut _
      Collate:=True, Copies:=2, ActivePrinter:=FindPrinterByPattern("(?:^| )2Sided(?: |$)")
      .Close True
   End With
   Kill ThisWorkbook.Path & "\New.xlsx"
End Sub


FindPrinterByPattern
Изменено: Ярослав Чикал - 02.08.2017 13:18:36
 
 
 
Страницы: 1
Читают тему
Наверх