Доброго времени суток, уважаемые форумчане. Нужно напечатать оч. много файлов, и их определенное кол-во. Нашел макрос в сети на данное действие. Подогнал под свои нужды, но не знаю как переделать его чтобы он печатал просто первый лист, а не по названию листа. Примерно теоретически понимаю что надо Shits1, но.... помогите. [vba]
Код
Sub Печать_заданных_листов_файлов_Excel_из_папки() Dim MyPath$, MyFileName$, ShName, i% MyPath = "C:\Users\Televnoy\Desktop\ewtetew\" ' Папка, из которой печатаем ShName = Array("Лист1", "Лист100") ' Набор имен листов к распечатке MyFileName = Dir(MyPath & "*.xlsx*") On Error Resume Next ' Если в файле нет заданного листа, то игнорируем и продолжаем работать Do Until MyFileName = "" If Left$(MyFileName, 2) <> "~$" Then ' Исключаем временные файлы Excel Workbooks.Open Filename:=MyPath & MyFileName, UpdateLinks:=0, ReadOnly:=True For i = 0 To UBound(ShName) ActiveWorkbook.Sheets(ShName(i)).PrintOut , Copies:=5 Next i ActiveWorkbook.Close 0 End If MyFileName = Dir Loop End Sub
[/vba]
Доброго времени суток, уважаемые форумчане. Нужно напечатать оч. много файлов, и их определенное кол-во. Нашел макрос в сети на данное действие. Подогнал под свои нужды, но не знаю как переделать его чтобы он печатал просто первый лист, а не по названию листа. Примерно теоретически понимаю что надо Shits1, но.... помогите. [vba]
Код
Sub Печать_заданных_листов_файлов_Excel_из_папки() Dim MyPath$, MyFileName$, ShName, i% MyPath = "C:\Users\Televnoy\Desktop\ewtetew\" ' Папка, из которой печатаем ShName = Array("Лист1", "Лист100") ' Набор имен листов к распечатке MyFileName = Dir(MyPath & "*.xlsx*") On Error Resume Next ' Если в файле нет заданного листа, то игнорируем и продолжаем работать Do Until MyFileName = "" If Left$(MyFileName, 2) <> "~$" Then ' Исключаем временные файлы Excel Workbooks.Open Filename:=MyPath & MyFileName, UpdateLinks:=0, ReadOnly:=True For i = 0 To UBound(ShName) ActiveWorkbook.Sheets(ShName(i)).PrintOut , Copies:=5 Next i ActiveWorkbook.Close 0 End If MyFileName = Dir Loop End Sub
Sub Печать_заданных_листов_файлов_Excel_из_папки() Dim MyPath$, MyFileName$ MyPath = "C:\Users\Televnoy\Desktop\ewtetew\" ' Папка, из которой печатаем ShIndex& = 1 ' Номер листа MyFileName = Dir(MyPath & "*.xlsx*") On Error Resume Next ' Если в файле нет заданного листа, то игнорируем и продолжаем работать Do Until MyFileName = "" If Left$(MyFileName, 2) <> "~$" Then ' Исключаем временные файлы Excel Workbooks.Open Filename:=MyPath & MyFileName, UpdateLinks:=0, ReadOnly:=True ActiveWorkbook.Sheets(ShIndex).PrintOut , Copies:=5 ActiveWorkbook.Close 0 End If MyFileName = Dir Loop End Sub
[/vba]
televnoy, Попробуйте так: [vba]
Код
Sub Печать_заданных_листов_файлов_Excel_из_папки() Dim MyPath$, MyFileName$ MyPath = "C:\Users\Televnoy\Desktop\ewtetew\" ' Папка, из которой печатаем ShIndex& = 1 ' Номер листа MyFileName = Dir(MyPath & "*.xlsx*") On Error Resume Next ' Если в файле нет заданного листа, то игнорируем и продолжаем работать Do Until MyFileName = "" If Left$(MyFileName, 2) <> "~$" Then ' Исключаем временные файлы Excel Workbooks.Open Filename:=MyPath & MyFileName, UpdateLinks:=0, ReadOnly:=True ActiveWorkbook.Sheets(ShIndex).PrintOut , Copies:=5 ActiveWorkbook.Close 0 End If MyFileName = Dir Loop End Sub
Sub Печать_заданных_листов_файлов_Excel_из_папки() Dim MyPath$, MyFileName$, bk As Workbook Application.ScreenUpdating = False MyPath = "C:\Users\Televnoy\Desktop\ewtetew\" ' Папка, из которой печатаем MyFileName = Dir(MyPath & "*.xlsx") Do While MyFileName <> "" If Left$(MyFileName, 2) <> "~$" Then ' Исключаем временные файлы Excel Set bk = Workbooks.Open(Filename:=MyPath & MyFileName, UpdateLinks:=False, ReadOnly:=True) bk.Worksheets(1).PrintOut Copies:=5 bk.Close SaveChanges:=False End If MyFileName = Dir Loop Application.ScreenUpdating = True MsgBox "Готово!", vbInformation End Sub
[/vba]
[vba]
Код
Sub Печать_заданных_листов_файлов_Excel_из_папки() Dim MyPath$, MyFileName$, bk As Workbook Application.ScreenUpdating = False MyPath = "C:\Users\Televnoy\Desktop\ewtetew\" ' Папка, из которой печатаем MyFileName = Dir(MyPath & "*.xlsx") Do While MyFileName <> "" If Left$(MyFileName, 2) <> "~$" Then ' Исключаем временные файлы Excel Set bk = Workbooks.Open(Filename:=MyPath & MyFileName, UpdateLinks:=False, ReadOnly:=True) bk.Worksheets(1).PrintOut Copies:=5 bk.Close SaveChanges:=False End If MyFileName = Dir Loop Application.ScreenUpdating = True MsgBox "Готово!", vbInformation End Sub
Karataev, Спасибо за решение Roman777, да - путь папки был другой, но я поменял его. Я же говорил копировал по новой - красное изчезло - через тестовый редактор, видимо атрибуты невидимые какие нибудь были. Я же ниже написал.Он открывал файл, и закрывал, печати не происходило. Karataev - помог с решением. Roman777 - вам тоже огромное спасибо за помощь.
Karataev, Спасибо за решение Roman777, да - путь папки был другой, но я поменял его. Я же говорил копировал по новой - красное изчезло - через тестовый редактор, видимо атрибуты невидимые какие нибудь были. Я же ниже написал.Он открывал файл, и закрывал, печати не происходило. Karataev - помог с решением. Roman777 - вам тоже огромное спасибо за помощь.televnoy
Народ подскажите что в код дописать что бы печатал не только первый лист, нужен первый второй и третий пробовал эти строки, все равно печатает только первый лист. Эксель русский 2016 ShIndex& = 1 ' Номер листа ShName = Array("Лист1", "Лист2", "Лист3") ' Набор имен листов к распечатке
Народ подскажите что в код дописать что бы печатал не только первый лист, нужен первый второй и третий пробовал эти строки, все равно печатает только первый лист. Эксель русский 2016 ShIndex& = 1 ' Номер листа ShName = Array("Лист1", "Лист2", "Лист3") ' Набор имен листов к распечаткеzingeroud
Сообщение отредактировал zingeroud - Четверг, 26.07.2018, 17:10
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
