Выбор принтера?

[Alex_new_2030]

У меня в сети есть несколько принтеров. Для печати я использую объект PRINTER. Он у меня использует только принетр по умолчанию. Как можно вывести список установленных принтеров и печатать через любого из них?

[Aleksej]

Private Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (Destination As Any, _
Source As Any, _
ByVal Length As Long)

Private Declare Function PrintDlg Lib "comdlg32.dll" Alias "PrintDlgA" ( _
pPrintdlg As PrintDlg) As Long

Private Declare Function GlobalLock Lib "kernel32" ( _
ByVal hMem As Long) As Long

Private Declare Function GlobalAlloc Lib "kernel32" ( _
ByVal wFlags As Long, _
ByVal dwBytes As Long) As Long

Private Declare Function GlobalUnlock Lib "kernel32" ( _
ByVal hMem As Long) As Long

Private Declare Function GlobalFree Lib "kernel32" ( _
ByVal hMem As Long) As Long

Private Type PrintDlg
lStructSize As Long
hwndOwner As Long
hDevMode As Long
hDevNames As Long
hdc As Long
flags As Long
nFromPage As Integer
nToPage As Integer
nMinPage As Integer
nMaxPage As Integer
nCopies As Integer
hInstance As Long
lCustData As Long
lpfnPrintHook As Long
lpfnSetupHook As Long
lpPrintTemplateName As String
lpSetupTemplateName As String
hPrintTemplate As Long
hSetupTemplate As Long
End Type

Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32

Private Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type

Public PrinterhDC As Long
Public PrinterName As String
Public Copies As Integer
Public PageOrientation As Byte

Private Const PD_RETURNDC = &H100
Private Const PD_USEDEVMODECOPIESANDCOLLATE = &H40000
Private Const PD_DISABLEPRINTTOFILE = &H80000
Private Const PD_NOSELECTION = &H4
Private Const DM_COPIES = &H100&
Private Const DM_ORIENTATION = &H1&
Private Const GMEM_MOVEABLE = &H2

Public Function ShowDlgPrint() As Boolean
Dim lResult As Long
Dim PrintShow As PrintDlg
Dim PrinterMode As DEVMODE
Dim hPointer As Long
Dim p As Printer
Dim strTempPrinterName As String

PrintShow.lStructSize = Len(PrintShow)
PrintShow.hDevMode = GlobalAlloc(GMEM_MOVEABLE, _
Len(PrinterMode))

PrintShow.hDevNames = 0
PrintShow.nCopies = 1
PrintShow.flags = PD_RETURNDC Or PD_DISABLEPRINTTOFILE Or _
PD_NOSELECTION

PrinterMode.dmSize = Len(PrinterMode)
PrinterMode.dmFields = DM_COPIES Or DM_ORIENTATION

lResult = PrintDlg(PrintShow)

If lResult = 0 Then
ShowDlgPrint = False
Exit Function
End If

PrinterhDC = PrintShow.hdc

hPointer = GlobalLock(PrintShow.hDevMode)

CopyMemory PrinterMode, _
ByVal hPointer, ByVal Len(PrinterMode)

PrinterName = Left$(PrinterMode.dmDeviceName, _
InStr(PrinterMode.dmDeviceName, _
Chr$(0)) - 1)

Copies = PrinterMode.dmCopies

PageOrientation = PrinterMode.dmOrientation

Call GlobalUnlock(PrintShow.hDevMode)

Call GlobalFree(PrintShow.hDevMode)

For Each p In Printers
With p
strTempPrinterName = .DeviceName
If strTempPrinterName = PrinterName Then
Set Printer = p
Printer.ScaleMode = vbMillimeters
Printer.Orientation = PageOrientation
Printer.Copies = Copies
Exit For
End If
End With
Next

ShowDlgPrint = True
End Function

[kif]

Есть вариант по проще:
для получения списка принтеров:

Dim i As Printer
Dim k As String
Dim kk As Integer

k = Printer.DeviceName 'запомнить имя принтера по умолчанию
On Error GoTo ErPrint
For Each i In Printers
ListPrinter.AddItem i.DeviceName 'загнать все принтера в список
Next
On Error GoTo 0

'перебрать их еще раз и в списке установить принтер по умолчанию
For kk = 0 To ListPrinter.ListCount - 1
If ListPrinter.List(kk) = k Then
ListPrinter.Text = ListPrinter.List(kk)
Exit For
End If
Next

'=====================================
'перед печатью

Dim k As Printer

'Установить принтер из списка - текущим
For Each k In Printers
If k.DeviceName = ListPrinter.Text Then
Set Printer = k
Exit For
End If
Next

[Rodos]

Код: Выделить всё

k = Printer.DeviceName 'запомнить имя принтера по умолчанию

Ругается на "Printer", пишет: Invalid outside procedure.

[Бяка]

почитай если интерестно ето:

[Бяка]

нечё шо так много получилось?

[Rodos]

Как сделать, чтобы принтер по умолчанию попадал на первое место в списке?

[Rodos]

Ну не может быть, чтобы никто не знал ответ на такой легкий для опытного программиста вопрос!

[alibek]

А вопрос в чем?

[Rodos]

Как сделать, чтобы принтер по умолчанию попадал на первое место в списке?

По коду от kif.

[alibek]

Добавляешь принтер по умолчанию, затем добавляешь все остальные. Это помоему очевидно.

[Rodos]

Если так сделать, то в списке появляется 3 одинаковых принтера.

Вот код:

Код: Выделить всё

Private Sub Form_Load()
k = Printer.DeviceName 'запомнить имя принтера по умолчанию
For Each i In Printers
Combo1.AddItem (k)
Combo1.AddItem i.DeviceName 'загнать все принтера в список
Next
On Error GoTo 0

[alibek]

Код: Выделить всё

Private Sub Form_Load
...
DP = Printer.DeviceName
Combo1.AddItem DP
For Each prn In Printers
  If prn.DeviceName <> DP Then Combo1.AddItem prn.DeviceName
Next prn
End Sub

[Rodos]

Спасибо!

[Rodos]

Ошибка 76 при повторной печати, того же документа.

Вот код:

Код: Выделить всё

Private Sub Command1_Click()
'перед печатью
Dim k As Printer

'Установить принтер из списка - текущим
For Each k In Printers
If k.DeviceName = Combo1.Text Then
Set Printer = k
Exit For
End If
Next

AllText = ""
Open "Data\123.txt" For Input As #1
Do While Not EOF(1)
Input #1, st
AllText = AllText + st
Loop
Close #1

Printer.Print AllText
Printer.EndDoc

End Sub

Помогите!

[Rodos]

Как исправить ошибку "Run-time error '76': Path not found"? И почему она появляется?

[vvs_adm]

Неужели с английским настолько туго?
Ну переведи тогда на сайте www.translate.ru (к примеру, не реклама ) фразу "path not found" и ты сразу же поймешь, почему она (ошибка) появляется.

[Rodos]

Перевести-то я перевел уже давно. Я имею в виду, почему она появляется в данной программе, вроде все правильно написано.
И почему при первой печати все нормально, а при повторной выдается эта ошибка, и даже выгрузка формы не помогает. Программа начанает опять работать, только после перезапуска.

[vvs_adm]

Rodos Ну если исходник небольшой - лепи, гляну. А если большой, то уже поздно и мне влом Потому что код

Код: Выделить всё

Private Sub Command1_Click()
    Dim AllText As String, st As String

    AllText = ""
    Open "C:\123.txt" For Input As #1
    Do While Not EOF(1)
        Input #1, st
        AllText = AllText + st
    Loop
    Close #1

    Printer.Print AllText
    Printer.EndDoc
End Sub

два раза отправляет на принтер документ без всяких ошибок.

[Rodos]

Вот:

Код: Выделить всё

Option Explicit

Dim i As Printer
Dim k As String
Dim kk As Integer
Dim AllText As String
Dim st As String

Private Sub Form_Load()
k = Printer.DeviceName 'запомнить имя принтера по умолчанию
Combo1.AddItem k
For Each i In Printers
If i.DeviceName <> k Then Combo1.AddItem i.DeviceName 'загнать все принтера в список
Next
On Error GoTo 0

'перебрать их еще раз и в списке установить принтер по умолчанию
For kk = 0 To Combo1.ListCount - 1
If Combo1.List(kk) = k Then
Combo1.Text = Combo1.List(kk)
Exit For
End If
Next

Printer.FontName = "Times New Roman"
Printer.FontSize = 12
End Sub

Private Sub Command1_Click()
'перед печатью
Dim k As Printer

'Установить принтер из списка - текущим
For Each k In Printers
If k.DeviceName = Combo1.Text Then
Set Printer = k
Exit For
End If
Next

AllText = ""
Open "Data\123.txt" For Input As #1
Do While Not EOF(1)
Input #1, st
AllText = AllText + st
Printer.Print AllText
Printer.EndDoc
Loop
Close #1

End Sub

[vvs_adm]

Ну все работает. Аж три раза послал . Может ты между первой и второй печатью удалил документ? Потому как ругаться он будет, если файл твой найти не может.

[BV]

2 Rodos

Почему путь к файлу относительный, а рабочая папка не указана?

[vvs_adm]

BV Ну так он либо сразу бы ругнулся, либо оба раза послал бы. А не так, как у него.

[Rodos]

Все, понял в чем дело. У меня тонер в принтере кончился и я все время посылал печать на виртуальный "Microsoft Office Document Image Writer" (думал он полностью заменяет физический), при повторной печати на него выдается эта ошибка. При печати на настоящий все нормально! Как же я сразу не догадался проверить .

[vvs_adm]

Rodos интересно, и в какой строке он ошибку тебе выдает при повторной печати?

[Rodos]

Код: Выделить всё

Open "Data\123.txt" For Input As #1