http://www.planetaexcel.ru/forum.php?thread_id=5185 Александр
04.08.2008, 16:48 Как получить список принтеров
Задача следующая:
Нужно распечатать с помощью макроса документ. Всё просто, НО
как задать активный принтер???
Application.activePrinter="имя принтера" не работает

он требует номер порта Ne00: , Ne01: и тд.

Вопрос :
Откуда узнать номер порта для конкретного принтера?

P.S. В реестре есть записи, где принтеру присваивается порт, но неужели нет возможностиузнать из Excel?

[ответить]
[цитировать]
Лузер™
04.08.2008, 17:57
Ответ очевиден: Экселем прочитать реестр.
VBA: Как получить значение нужной записи из раздела в реестре Windows ?
http://www.msoffice.nm.ru/faq/macros/miscellaneous2.htm#faq381
VBA: Как получить список всех значений и всех записей указанного раздела ?
http://www.msoffice.nm.ru/faq/macros/miscellaneous2.htm#faq382

[ответить]
[цитировать]
Лузер™
04.08.2008, 18:11
Со ссылками поторопился.
там есть комментарий:
Данная инструкция позволяет работать только с одним разделом реестра, а именно HKEY_USERS\...\VB and VBA Program Settings\...
Это написано про SaveSetting, но, боюсь, это относится и к GetAllSettings
Но сути дела не меняет: Читать ветку реестра.

[ответить]
[цитировать]
Pavel55
04.08.2008, 19:02
Может как-нибудь так, см. пример


К сообщению прикреплен файл: post_26604.xls
[ответить]
[цитировать]
Александр
04.08.2008, 19:14
Пример не канает.
с портом определяется только активный принтер!
а мне нужно узнать порты неактивых, чтобы сделать один из них активным!
есть еще предложения?

[ответить]
[цитировать]
Pavel55
04.08.2008, 21:07
А вот так? (проверить не могу, дома нет принтеров) )


К сообщению прикреплен файл: post_26613.xls
[ответить]
[цитировать]
ZVI
04.08.2008, 21:19 Re: Как получить список принтеров
---
См. приложение.
VB-код взят из Интернета (ссылка есть в коде формы).
Адаптирован под VBA.
---
ZVI


К сообщению прикреплен файл: post_26614.rar
[ответить]
[цитировать]
Александр
04.08.2008, 23:26
Pavel55
Спасибо!
То что надо!

[ответить]
[цитировать]
Александр
05.08.2008, 07:57
Народ, огромная просьба...
Можете макрос из последнего сообщения пашки выложить текстом?
Я вчера дома смотрел, а сейчас на работе. У нас стоит антивирусна прокси сервере который не позволяет скачивать файлы с макросами

[ответить]
[цитировать]
dsapa
05.08.2008, 08:47
Option Explicit

Private Declare Function GetProfileString Lib "kernel32" _
Alias "GetProfileStringA" (ByVal lpAppName As String, _
ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long) As Long

Sub Test()
Dim vaList
'Get all printers
vaList = PrinterFind
'Show m
MsgBox Join(vaList, vbLf), , "List of printers"
'Get all printers with A3 paper size
vaList = PrinterFind(Match:="A3")
'Switch to the first "A3 paper size" found
If UBound(vaList) = -1 Then
MsgBox "Printer not found"
ElseIf MsgBox("from " & vbTab & ": " & ActivePrinter & vbLf & _
"to " & vbTab & ": " & vaList(0), _
vbOKCancel, "Switch Printers") = vbOK Then
Application.ActivePrinter = vaList(0)
End If
End Sub

Public Function PrinterFind(Optional Match As String) As String()
Dim n%, lRet&, sBuf$, sCon$, aPrn$()
Const lLen& = 1024, sKey$ = "devices"
'------------------------------------------------------------------
'written by keepITcool

'requires xl2000 or newer.
'returns a zerobased array of complete localized printer strings
'results are filtered on Match string, if no result the ubound = -1
'------------------------------------------------------------------
'Split ActivePrinter string to get localized word for "on"
aPrn = Split(Excel.ActivePrinter)
sCon = " " & aPrn(UBound(aPrn) - 1) & " " '
'Read all installed printers (1k bytes s/b enough)
sBuf = Space(lLen)
lRet = GetProfileString(sKey, vbNullString, vbNullString, sBuf, lLen)
If lRet = 0 Then
Err.Raise vbObjectError + 513, , "Can't read Profile"
Exit Function
End If
'Split buffer string
aPrn = Split(Left(sBuf, lRet - 1), vbNullChar)
'Filter array on Match
If Match <> vbNullString Then aPrn = Filter(aPrn, Match, -1, 1)
For n = LBound(aPrn) To UBound(aPrn)
'Add 16bit portname for each Printer
sBuf = Space(lLen)
lRet = GetProfileString(sKey, aPrn(n), vbNullString, sBuf, lLen)
aPrn(n) = aPrn(n) & " (" & Mid(sBuf, InStr(sBuf, ",") + 1, lRet - InStr(sBuf, ",") - 1) & ":)"
Next
'Return the result
PrinterFind = aPrn
End Function

[ответить]
[цитировать]
Александр
05.08.2008, 08:48
Спасибо

[ответить]
[цитировать]
Евгений
04.02.2011, 16:14
Sheets("Dogovor").Select
Range("A1:I147").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$147"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="doPDF v7", Collate:=True

Вот такой кусок кода работает отлично, причем не используя заумные фунции.
В справке по разделу PrintOut Method есть описание, число копий, и АКТИВНЫЙ ПРИНТЕР. Единственное, что необходимо указать точное имя... в моем случае это
doPDF v7. Это виртуальный принтер принтер для конвертации экселя в PDF формат.

[ответить]
[цитировать]
_Лена_
16.04.2012, 20:02
написала себе, делюсь!!!!

задать нужный принтер по маске:
единственное, что нужно - задать значение МаскаПринтера.
будет искать по соответствию *МаскаПринтера*

------------------------------
Option Explicit

Private Declare Function GetProfileString Lib "kernel32" _
Alias "GetProfileStringA" (ByVal lpAppName As String, _
ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long) As Long

Sub Test()
Dim СписокП, n, МаскаПринтера
МаскаПринтера = "Adobe"
СписокП = PrinterFind
For n = 0 To UBound(СписокП)
If СписокП(n) Like "*" & МаскаПринтера & "*" Then
Debug.Print СписокП(n)
Application.ActivePrinter = СписокП(n)
Exit For
End If
Next
End Sub

Public Function PrinterFind(Optional Match As String) As String()
Dim n%, lRet&, sBuf$, sCon$, aPrn$()
Const lLen& = 1024, sKey$ = "devices"
aPrn = Split(Excel.ActivePrinter)
sCon = " " & aPrn(UBound(aPrn) - 1) & " " '
sBuf = Space(lLen)
lRet = GetProfileString(sKey, vbNullString, vbNullString, sBuf, lLen)
If lRet = 0 Then
Err.Raise vbObjectError + 513, , "Can't read Profile"
Exit Function
End If
aPrn = Split(Left(sBuf, lRet - 1), vbNullChar)
If Match <> vbNullString Then aPrn = Filter(aPrn, Match, -1, 1)
For n = LBound(aPrn) To UBound(aPrn)
sBuf = Space(lLen)
lRet = GetProfileString(sKey, aPrn(n), vbNullString, sBuf, lLen)
aPrn(n) = aPrn(n) & " (" & Mid(sBuf, InStr(sBuf, ",") + 1, lRet - InStr(sBuf, ",") - 1) & ":)"
Next
PrinterFind = aPrn
End Function

[ответить]
[цитировать]
Hugo
Число сообщений: 11588
16.04.2012, 20:26
Спасибо, обязательно кому-то пригодится.
Только я бы в общем случае сперва запоминал текущий принтер в переменную, потом делал активным нужный виртуальный пдф, печатал на него, затем возвращал принтер назад.
_______________________
hugo nxt ru webmoney: E265281470651 Z422237915069 R418926282008
[ответить]
[цитировать]
anvg
Число сообщений: 531
17.04.2012, 03:15
Ещё пять копеек
Public Sub GetPrintersInfo()
On Error Resume Next
Dim objWMIService As Object
Dim objPrinters As Object
Dim objPrinter As Object
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set objPrinters = objWMIService.ExecQuery("Select * from Win32_Printer", , 48)
For Each objPrinter In objPrinters
Debug.Print "Printer: " & objPrinter.Caption & vbTab & "Port: " & objPrinter.PortName
Next objPrinter
End Sub
Детали тут
http://msdn.microsoft.com/en-us/library/windows/desktop/aa394363%28v=vs.85%29.aspx