AW: Drucker anhalten?
29.05.2008 15:52:43
Tino
Hallo,
versuche es mal hiermit
Option Explicit
Private Declare Function SetPrinter Lib "winspool.drv" Alias _
"SetPrinterA" (ByVal hPrinter As Long, ByVal Level _
As Long, pPrinter As Byte, ByVal Command As Long) _
As Long
Private Declare Function OpenPrinter Lib "winspool.drv" Alias _
"OpenPrinterA" (ByVal pPrinterName As String, phPrinter _
As Long, pDefault As PRINTER_DEFAULTS) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long
Private Type PRINTER_DEFAULTS
pDatatype As Long
pDevMode As Long
DesiredAccess As Long
End Type
Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Const PRINTER_ACCESS_ADMINISTER As Long = &H4
Const PRINTER_ACCESS_USE As Long = &H8
Const PRINTER_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or _
PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)
Private Const PRINTER_CONTROL_PURGE As Long = 3&
Private Const PRINTER_CONTROL_PAUSE As Long = 1&
Private Const PRINTER_CONTROL_RESUME As Long = 2&
Private Sub PrinterCommand(ByVal Command As Long)
Dim PName As String
Dim Result As Long, hPrinter As Long
Dim pd As PRINTER_DEFAULTS
pd.DesiredAccess = PRINTER_ALL_ACCESS
PName = Left$(ActivePrinter, InStr(ActivePrinter, "auf") - 2) 'gibt den Druckernamen aus
Result = OpenPrinter(PName, hPrinter, pd)
If Result = 0 Then
Call MsgBox("Ein Druckerhandle konnte nicht erstellt werden." & _
vbNewLine & "Möglicherweise verfügen Sie nicht über die " & _
"erforderlichen Rechte zum Ausführen dieser Aktion.", _
vbExclamation + vbOKOnly, ThisWorkbook.Title)
Exit Sub
End If
Result = SetPrinter(hPrinter, 0, vbNull, Command)
If Result = 0 Then
Call MsgBox("Die angeforderte Aktion konnte aufgrund eines " & _
"Fehlers nicht durchgeführt werden.", _
vbExclamation + vbOKOnly, ThisWorkbook.Title)
End If
Result = ClosePrinter(hPrinter)
End Sub
Sub Druckereinstellung()
'PRINTER_CONTROL_PURGE = lösche Druckaufträge
'PRINTER_CONTROL_PAUSE = Drucker anhalten
'PRINTER_CONTROL_RESUME = drucker fortsetzen
Call PrinterCommand(PRINTER_CONTROL_PAUSE)
End Sub
Gruß
Tino
www.tinomargit.com