Есть макрос, который из нескольких файлов печатает нужные листы(вкладки) согласно списка в столбце (работает по принципу: выбирается нужная папка для печати, затем открывается файл - проверяется наличие вкладки - на печать, закрывается и следующий...).
Все бы хорошо, но один косяк: отправляет по одному листу, и если много чего печатать, то получается задание на печать из длинного списка по 1-5 страницам в каждом. Принтер очень долго обрабатывает каждое задание. Хотелось бы, чтобы всю эту кучу задач объединить воедино и на принтер отправлялось одним файлом с множеством страниц (или по группам както объединить, но уменьшить число задач в итоге. Страницы в экселе подогнаны под А4. Возможно оптимизируете программу - изначально он открывает файл - проверяет 1 ячеку из таблицы листов, потом открывает и проверяет 2 ячейку и так каждый файл (изначально задача, чтобы печатал именно все листы одного названия из всех файлов, потом все листы другого из всех файлов...
Все бы хорошо, но один косяк: отправляет по одному листу, и если много чего печатать, то получается задание на печать из длинного списка по 1-5 страницам в каждом. Принтер очень долго обрабатывает каждое задание. Хотелось бы, чтобы всю эту кучу задач объединить воедино и на принтер отправлялось одним файлом с множеством страниц (или по группам както объединить, но уменьшить число задач в итоге. Страницы в экселе подогнаны под А4. Возможно оптимизируете программу - изначально он открывает файл - проверяет 1 ячеку из таблицы листов, потом открывает и проверяет 2 ячейку и так каждый файл (изначально задача, чтобы печатал именно все листы одного названия из всех файлов, потом все листы другого из всех файлов...
Код |
---|
Sub Печать() 'Печатает поочередно каждый Лист из заданного списка последовательно из всех файлов выбранной папки Application.ScreenUpdating = True Dim MyWorkbook As Workbook, MyWorkbook2 As Workbook Dim MyRange As Range Dim LastRow As Long, i As Long, w As Long Dim MyFileName As String, MyFileFullName As String Dim ListToPrint 'MyWorkbook = ActiveWorkbook LastRow = Range("B2").CurrentRegion.Rows.Count Set MyRange = ThisWorkbook.Worksheets(1).Range("B2:B" & 2 + LastRow - 1) ListToPrint = MyRange.Value 'Пользователь выбирает папку с файлами для печати If MsgBox("Выберите папку с файлами для печати:", vbOKCancel) = vbCancel Then MsgBox "Папка не выбрана" Exit Sub End If MyPapka = GetFolder() 'оффаемся, если папка не выбрана If MyPapka = "" Then MsgBox "Папка не выбрана" Exit Sub End If Application.ScreenUpdating = False 'Печать последовательно каждой страницы из всех файлов типа *123* On Error Resume Next For i = LBound(ListToPrint, 1) To UBound(ListToPrint, 1) MyFileName = Dir(MyPapka & "*123*") Do While Len(MyFileName) > 0 MyFileFullName = MyPapka & MyFileName Set MyWorkbook2 = Workbooks.Open(MyFileFullName) 'Печатаем i-ый Лист из всех файлов, если есть данные For w = 1 To MyWorkbook2.Worksheets.Count If MyWorkbook2.Worksheets(w).Name = ListToPrint(i, 1) Then With MyWorkbook2.Worksheets(ListToPrint(i, 1)) .Activate If Not IsEmpty(.Range("A4").Value) And Not IsEmpty(.Range("B4").Value) And Not IsEmpty(.Range("C4").Value) Then MyWorkbook2.Worksheets(ListToPrint(i, 1)).PrintOut 'Debug.Print MyFileName, ListToPrint(i, 1), MyWorkbook2.Worksheets(ListToPrint(i, 1)).Range("A4").Value, 'MyWorkbook2.Worksheets(ListToPrint(i, 1)).Range("B4").Value , MyWorkbook2.Worksheets(ListToPrint(i, 1)).Range("C4").Value End If Exit For End With End If Next w MyWorkbook2.Close (False) 'выбираем новый файл: MyFileName = Dir() Loop Next i Application.ScreenUpdating = True End Sub |