Макрос в excel печать по кнопке - Word и Excel - помощь в работе с программами

на листе экселя кнопка для отправки на печать

koyaanisqatsi

Дата: Среда, 04.02.2015, 10:04 |
Сообщение № 1

Группа: Проверенные

Ранг: Ветеран

Сообщений: 712

Репутация:
15
±

Замечаний:
0% ±

Excel 2010

Допустим имя принтера сработает и порт не надо будет прописывать.

Как послать активный лист экселя который содержит много разрывов страниц на принтер указанный в макросе отличный от дефолтного и чтобы макрос не менял дефолтный принтер. Просто при нажатии отправлял на прописаный принтер.

К сообщению приложен файл:

7531803.xlsx
(55.6 Kb)

Ответить

SLAVICK

Дата: Среда, 04.02.2015, 11:13 |
Сообщение № 2

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация:
766
±

Замечаний:
0% ±

2019

Изменил сообщение, еще раз

[vba]

Код

Sub dd()
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:=»Microsoft XPS Document Writer»‘ Вместо «Microsoft XPS Document Writer» — впишите нужный принтер
End Sub

[/vba]
На первый взгляд — то что нужно
Чтоб вернуть принтер назад:
Application.ActivePrinter = «MyPrinter» ‘ Вместо MyPrinter вписать нужный принтер.

Взял здесь

К сообщению приложен файл:

7531803.xlsm
(55.8 Kb)

Иногда все проще чем кажется с первого взгляда.

Сообщение отредактировал SLAVICK — Среда, 04.02.2015, 12:02

Ответить

SLAVICK

Дата: Среда, 04.02.2015, 12:08 |
Сообщение № 3

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация:
766
±

Замечаний:
0% ±

2019

Подкорректировал макрос

[vba]

Код

Sub Отправка_листа_на_нужный_принтер()
Dim aPr$
aPr = Application.ActivePrinter
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:=»Microsoft XPS Document Writer» ‘ Вместо «Microsoft XPS Document Writer» — впишите нужный принтер
Application.ActivePrinter = aPr ‘ Возврат активного принтера
End Sub

[/vba]

Иногда все проще чем кажется с первого взгляда.

Сообщение отредактировал SLAVICK — Среда, 04.02.2015, 12:09

Ответить

koyaanisqatsi

Дата: Четверг, 05.02.2015, 09:41 |
Сообщение № 4

Группа: Проверенные

Ранг: Ветеран

Сообщений: 712

Репутация:
15
±

Замечаний:
0% ±

Excel 2010

Обалдеть красота ! ! ! Счастье )))) Все работает.

Ответить

koyaanisqatsi

Дата: Четверг, 05.02.2015, 10:17 |
Сообщение № 5

Группа: Проверенные

Ранг: Ветеран

Сообщений: 712

Репутация:
15
±

Замечаний:
0% ±

Excel 2010

К теме наверно уже не относится только непонятно что делать с таким явлением. Я не знаю от чего это зависит и будет ли менятся в дальнейшем. Принтер на который надо послать пока называется так «ZDesigner GC420d (перенаправлено 19)» Меня вот конкретно это смущает » (перенаправлено 19)» вижу в списках часто что за принтером пишется такая зяба и цифры разные. Если для этого номер изменится то по кнопке и печать не пойдет (

Ответить

SLAVICK

Дата: Четверг, 05.02.2015, 11:35 |
Сообщение № 6

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация:
766
±

Замечаний:
0% ±

2019

Так воспользуйтесь проверкой наличия принтера в списке доступных.
Вы же в теме спрашивали про список доступных принтеров
Если нужный принтер есть — печатаем, если нет — предлагаем выбрать из списка, или выходим… как то так <_<
[vba]

Код

Sub Отправка_листа_на_нужный_принтер_c_проверкой()
Dim aPr$, s$, AllPrinters As Object, printer As Object, n%, m, primary_printer$, print_name$
primary_printer = «doPDF v9» ‘ Вместо «doPDF v7» — впишите нужный принтер по умолчанию
aPr = Application.ActivePrinter
Set AllPrinters = GetObject(«winmgmts://./root/CIMV2»).ExecQuery(«SELECT * FROM Win32_Printer», , 48)
‘Получаем список принтеров
     For Each printer In AllPrinters
         n = n + 1
         s = s & vbCr & n & «: » & printer.name
         If printer.name = primary_printer Then print_name = primary_printer: Exit For ‘ если primary_printer найден в списке доступных
     Next
     s = Right(s, Len(s) — 1)
‘Если такого принтера не найдено:
If print_name = «» Then
     If InStr(1, s, vbCr, vbTextCompare) = 0 Then MsgBox «Error no printers»: Exit Sub
     m = Split(s, vbCr)
     n = InputBox(«input Number of printer:» & vbCr & s, «Not found:» & primary_printer, 1)
     If n > UBound(m) Or n = 0 Then MsgBox «Error no printers with this number»: Exit Sub
     print_name = Split(m(n — 1), » «, 2)(1)
End If
‘===============================
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:=print_name
Application.ActivePrinter = aPr ‘ Возврат активного принтера
End Sub

[/vba]

К сообщению приложен файл:

2632828.xlsm
(55.4 Kb)

Иногда все проще чем кажется с первого взгляда.

Сообщение отредактировал SLAVICK — Четверг, 05.02.2015, 23:21

Ответить

koyaanisqatsi

Дата: Пятница, 06.02.2015, 12:18 |
Сообщение № 7

Группа: Проверенные

Ранг: Ветеран

Сообщений: 712

Репутация:
15
±

Замечаний:
0% ±

Excel 2010

SLAVICK, ОГО !

Спасибо доберусь до этого макроса в Понедельник но думаю что все будет работать Спасибо огромное )

Ответить

koyaanisqatsi

Дата: Понедельник, 16.02.2015, 14:53 |
Сообщение № 8

Группа: Проверенные

Ранг: Ветеран

Сообщений: 712

Репутация:
15
±

Замечаний:
0% ±

Excel 2010

SLAVICK, Еще раз спасибо. Макрос работает почти идеально.
Внедрил. Отчитываюсь о работе.

1. Если при выборе принтера нажать эскейп то выдает сообщение об ошибке. Дебаг в строке
[vba]

Код

n = InputBox(«input Number of printer:» & vbCr & s, «Not found:» & primary_printer, 1)

[/vba]

2. После отправки на печать если все хорошо сам эксель или макрос подвешивается на секунды 3-5 где-то. Наверно это плохо.

Скорее всего второе важнее чем первое.

И еще маленький вопросик. Если я создам отдельную страницу для того что бы этот макрос брал оттуда название принтера. Как это написать в самом макросе ? просто тут такая проблемака что имя принтера не статично вчера допустим было ZDesigner GC420d (перенаправлено 16) а завтра будет к примеру ZDesigner GC420d (перенаправлено 21)

Если бы можно было в ячейке изменять а в идеале сохранять макросом и брать оттуда последний выбранный принтер то было бы просто идеально. Ну скажем страница будет называться Принтер ячейка любая.

Заранее благодарен.

Сообщение отредактировал koyaanisqatsi — Понедельник, 16.02.2015, 14:58

Ответить

SLAVICK

Дата: Понедельник, 16.02.2015, 15:53 |
Сообщение № 9

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация:
766
±

Замечаний:
0% ±

2019

1. исправьте строку на:
[vba]

Код

n = Val(InputBox(«input Number of printer:» & vbCr & s, «Not found:» & primary_printer, 1))

[/vba]
2. возможно(у меня нет задержек). Макрос изменяет активность принтера(два раза на указанный, а потом на первоначальный). Если принтер сетевой- нужно ему отправить запрос, и получить с него ответ. Тут вопрос быстродействия связи сетки… Кроме того изменяются параметры печати согласно этому принтеру. Чем больше документ, тем больше нужно изменять. Не думаю, что это можно как-то исправить
3. так укажите полный путь к ячейке с листом например:
[vba]

Код

primary_printer = Sheets(«printer»).Cells(1, «a»).Value ‘ Вместо «doPDF v7» — впишите нужный принтер по умолчанию

[/vba]

К сообщению приложен файл:

2649787.xlsm
(60.1 Kb)

Иногда все проще чем кажется с первого взгляда.

Сообщение отредактировал SLAVICK — Понедельник, 16.02.2015, 15:56

Ответить

koyaanisqatsi

Дата: Понедельник, 16.02.2015, 16:29 |
Сообщение № 10

Группа: Проверенные

Ранг: Ветеран

Сообщений: 712

Репутация:
15
±

Замечаний:
0% ±

Excel 2010

SLAVICK, Спасибо.
А чтобы он сохранял в ячейку последний выбранный если не нашел предыдущий принтер так можно ? Или придется самостоятельно в той ячейке исправлять название принтера на новое текущее если изменится последнее число в названии принтера ?

С сетью понял, мы посылаем с сервера на локальный принтер. Хотя если без макроса посылать такой задержки нет. Ну ладно. Остальное все работает кроме сохранения последнего выбранного принтера в ячейку на странице printer в A1

Сообщение отредактировал koyaanisqatsi — Понедельник, 16.02.2015, 16:40

Ответить

SLAVICK

Дата: Понедельник, 16.02.2015, 18:44 |
Сообщение № 11

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация:
766
±

Замечаний:
0% ±

2019

Можно.
после
[vba]

Код

print_name = Split(m(n — 1), » «, 2)(1)

[/vba]
добавьте:
[vba]

Код

Sheets(«printer»).Cells(1, «a»).Value = print_name

[/vba]

К сообщению приложен файл:

1777020.xlsm
(60.3 Kb)

Иногда все проще чем кажется с первого взгляда.

Ответить

koyaanisqatsi

Дата: Вторник, 17.02.2015, 10:12 |
Сообщение № 12

Группа: Проверенные

Ранг: Ветеран

Сообщений: 712

Репутация:
15
±

Замечаний:
0% ±

Excel 2010

SLAVICK, Не зря я этим обеспокоился )
Отлично работает. И имя принтера конечно же уже поменялось. Но теперь проблема не проблема )

Ответить

Источник

6 / 7 / 1

Регистрация: 05.11.2013

Сообщений: 305

Макрос.Вывод на печать

04.06.2020, 09:47. Показов 5729. Ответов 8

Книга содержит листы : Январь,Февраль…Декабрь.
Как заставить машину распечатать листы с Марта по Август ?

малоболт

1143 / 442 / 193

Регистрация: 30.01.2020

Сообщений: 1,095

04.06.2020, 10:05

Сообщение от 0mega

Как заставить машину распечатать листы с Марта по Август ?

Если ручками — то просто выделить нужные листы. И потом, на странице настроек печати выбрать:
Напечатать активные листы.
Или нужно именно макросом решить?

Изображения

6 / 7 / 1

Регистрация: 05.11.2013

Сообщений: 305

04.06.2020, 10:46

[ТС]

Сообщение от Punkt5

Или нужно именно макросом решить?

Сообщение от 0mega

Макрос.Вывод на печать

Настоящая тема — это упрощенный вариант моего вопроса.
В действительности — Листов в книге больше 12-и
На некоторых листах производятся расчеты и выполняются команды.
Естественно. перебирать все листы и выделять нужные — эта перспектива мне не в кассу .
Мне нужен макрос который будет отправлять документ на принтер .
Написать через компилятор у меня не получилось

Punkt5

малоболт

1143 / 442 / 193

Регистрация: 30.01.2020

Сообщений: 1,095

04.06.2020, 10:52

Сообщение от 0mega

Мне нужен макрос который будет отправлять документ на принтер

Ну, через запись макросов получается так:

Visual Basic

1 2	Sheets(Array("Март", "Апрель", "Май", "Июнь", "Июль", "Август")).Select ActiveWindow.SelectedSheets.PrintOut

Соответственно Array со списком названий листов можно сделать свой и заранее
Можно и в одну строку попробовать:

Visual Basic

1	Sheets(Array("Март", "Апрель", "Май", "Июнь", "Июль", "Август")).PrintOut

Это поможет?

6 / 7 / 1

Регистрация: 05.11.2013

Сообщений: 305

04.06.2020, 11:13

[ТС]

Сообщение от Punkt5

Это поможет?

Поможет или нет — не знаю . Сейчас нет возможности проверить .

а нельзя ли как-то запись укоротить ?
что- то типа
Sheets(3:8)

Punkt5

малоболт

1143 / 442 / 193

Регистрация: 30.01.2020

Сообщений: 1,095

04.06.2020, 11:54

Сообщение от 0mega

а нельзя ли как-то запись укоротить ?
что- то типа
Sheets(3:8)

В моей практике не встречалось
Можно попробовать как-нибудь так:

Visual Basic

1 2	aa=array(3,4,5,6,7,8) Sheets(aa).Printout Preview:=True

Или заполнять массив в цикле. Но обязательно массив. Так, чтобы как с ячейками — указать начальный и конечный номер листа через двоеточие — не видел.

6 / 7 / 1

Регистрация: 05.11.2013

Сообщений: 305

04.06.2020, 12:11

[ТС]

а какой будет код, если надо распечатать все кроме 2-го и 8-го листа ?

pashulka

4131 / 2235 / 940

Регистрация: 01.12.2010

Сообщений: 4,624

04.06.2020, 17:58

0mega, Всё равно на печать листы будут выводить по очереди, стало быть, можно замутить ещё и так :

Visual Basic

For i = 3 To 8
    Worksheets(i).PrintOut
    'Worksheets(MonthName(i)).PrintOut
Next

А выкинуть 2 и 8, так :

Visual Basic

1
2
3

For i = 1 To Worksheets.Count
    If i <> 2 And i <> 8 Then Worksheets(i).PrintOut
Next

P.S. Конечно, если печатать нужно всё время разные листы, то имеет смысл создать UserForm с ListBox.
У списка разрешить многократное выделение и печатать только выделенные(выбранные) элементы(листы)

6 / 7 / 1

Регистрация: 05.11.2013

Сообщений: 305

05.06.2020, 08:33

[ТС]

pashulka спасибо
Изюмчик ковырнул

IT_Exp Эксперт 87844 / 49110 / 22898 Регистрация: 17.06.2006 Сообщений: 92,604	05.06.2020, 08:33
9

Источник

Добрый день!

Есть кнопка, которая запускает следующий макрос:

Sub SaveThisBook3()
Dim FolderName2 As Range
Set FolderName2 = ThisWorkbook.Worksheets(«Лист1»).Range(«G1»)
Dim PathToSave As String, FolderName As String, FellPathToSave As String
Dim fs As Object
PathToSave = «P:2010» ‘<————— Здесь укажи путь к папке в которую нужно сохранить книгу
FolderName = FolderName2 ‘<————— Здесь задай название папки
FellPathToSave = PathToSave & FolderName & «»
Set fs = CreateObject(«Scripting.FileSystemObject»)
If Not fs.FolderExists(FellPathToSave) Then
fs.CreateFolder (FellPathToSave)
End If
Application.ThisWorkbook.SaveAs FellPathToSave & «Приход » & Left(Now, 10) & «.xlsx»
End Sub

Этот макрос привязан к кнопке, при нажатию на которую создается в указанном каталоге новая папка, имя которой берется из ячейки и туда же, под тем же именем, сохраняется сам файл.

Мне нужно добавить в этот макрос печать — чтобы после того, как папка создалась, файл распечатался. В крайнем случае, чтобы автоматом вызывался диалог печати.

Спасибо.

В Excel есть такая замечательная штука как Запись макроса (Сервис -> Макрос -> …). Выполнив после начала записи определённые действия, например такие как печать, сохранение, добавление листов, данных в ячейки… да чего угодно, можно получить готовенький код макроса.

Знания недостаточно, необходимо применение. Желания недостаточно, необходимо действие. (с) Брюс Ли

Спасибо!

Попробовал записать, вот что получилось:

Sub mAcros1()
‘
‘ mAcros1 Макрос
‘ mm
‘

‘
Application.Run Range()
Application.ActivePrinter = «\192.168.1.45PRINTERCC245 (Ne02:)»
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
«\192.168.1.45PRINTERCC245 (Ne02:)», Collate:=True
End Sub

Выдает ошибку:

Copmpile error: argument not optimal

Во-первых, свою процедуру нельзя называть Range() (это зарезервированное имя Excel), а, во-вторых, программный запуск другого макроса должен выглядеть так:

Application.Run "Книга1!My_Range"

Или что за действие там у тебя первой строкой перед печатью должно происходить?

Знания недостаточно, необходимо применение. Желания недостаточно, необходимо действие. (с) Брюс Ли

Я тыкаю на кнопку, которая создает каталог и сохраняет туда файл, а потом вызываю диалог печати и печатаю содерждимое файла.

Предлагаю поменять последовательность с такой:

Sub Макрос1() 'Нажатие кнопки 'Печать End Sub


Private Sub CommandButton1_Click()
  'Сохранение файла
End Sub

на такую:

Sub Макрос1() 'Раньше здесь был код, записанный макрорекордером. 'Теперь же, когда мы узнали как нужно автоматически запускать на печать, 'код более не требуется End Sub


Private Sub CommandButton1_Click()
  'Сохранение файла
  'Печать
End Sub

Знания недостаточно, необходимо применение. Желания недостаточно, необходимо действие. (с) Брюс Ли

C VBA сталкиваюсь первый раз! создал кнопку прописал макрос:

Sub Кнопка2_Щелчок()
Dim FolderName2 As Range
Set FolderName2 = ThisWorkbook.Worksheets(«НСС»).Range(«Y1»)
Dim PathToSave As String, FolderName As String, FellPathToSave As String
Dim fs As Object
PathToSave = «D:2010»
FolderName = FolderName2
FellPathToSave = PathToSave & FolderName & «»
Set fs = CreateObject(«Scripting.FileSystemObject»)
If Not fs.FolderExists(FellPathToSave) Then
fs.CreateFolder (FellPathToSave)
End If
Application.ThisWorkbook.SaveAs FellPathToSave & «VedomostNSS_» & Left(Now, 10) & «.xlsm»
End Sub

все отлично работает, но мне необходимо чтобы к имени файла добавлялось не просто дата а еще и время. В Y1 у меня стоит функция =СЕГОДНЯ(), если меняю на =TDATA(), то выдает ошибку. В чем причина

Цитата: Gery от 29.07.2010, 14:29
но мне необходимо чтобы к имени файла добавлялось не просто дата а еще и время.

Чтобы вместе со временем нужно просто заменить эту строку:

Application.ThisWorkbook.SaveAs FellPathToSave & "VedomostNSS_" & Left(Now, 10) & ".xlsm"

На такую:

Application.ThisWorkbook.SaveAs FellPathToSave & "VedomostNSS_" & Now & ".xlsm"
Но лучше заменять двоеточия и точки на что-нибудь другое. Например так:

Application.ThisWorkbook.SaveAs FellPathToSave & "VedomostNSS_" & Format(Now, "DD_MM_YYYY HH_MM_SS") & ".xlsm"

P.S. Хотя и для только даты можно было написать короче:

Application.ThisWorkbook.SaveAs FellPathToSave & "VedomostNSS_" & Date & ".xlsm"

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…
www.excel-vba.ru
Просто СПАСИБО [+оказать+]
Считаешь СПАСИБО мало? Яндекс.Деньги: 41001332272872; WM: R298726502453

Спасибо, Prist! ТЫ МЕГА МОЗГ!!

Источник