AW: Drucker über ComboBox auswählen
24.09.2004 17:50:35
chris
Ist VB musst du etwas umbauen damit es in Excel funktioniert !
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
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 SetPrinter Lib "winspool.drv" Alias _
"SetPrinterA" (ByVal hPrinter As Long, ByVal Level _
As Long, pPrinter As Any, ByVal Command As Long) As Long
Private Declare Function GetPrinter Lib "winspool.drv" _
Alias "GetPrinterA" (ByVal hPrinter As Long, _
ByVal Level As Long, pPrinter As Any, ByVal cbBuf _
As Long, pcbNeeded As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" _
Alias "lstrcpyA" (ByVal lpString1 As String, _
ByVal lpString2 As Any) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long
Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const PRINTER_ATTRIBUTE_DEFAULT = 4
Const PRINTER_ACCESS_ADMINISTER = &H4
Const PRINTER_ACCESS_USE = &H8
Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
PRINTER_ACCESS_ADMINISTER Or _
PRINTER_ACCESS_USE)
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
dmLogPixels As Integer
dmBitsPerPel As Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
dmICMMethod As Long
dmICMIntent As Long
dmMediaType As Long
dmDitherType As Long
dmReserved1 As Long
dmReserved2 As Long
End Type
Private Type PRINTER_INFO_5
pPrinterName As String
pPortName As String
Attributes As Long
DeviceNotSelectedTimeout As Long
TransmissionRetryTimeout As Long
End Type
Private Type PRINTER_DEFAULTS
pDatatype As Long
pDevMode As DEVMODE
DesiredAccess As Long
End Type
Dim m_sCurrPrinterDevName$, m_sPrevPrinterDevName$
Dim m_sPrevPrinterDriver$, m_sPrevPrinterPort$
Private Sub Form_Load()
Dim x%
For x = 0 To Printers.Count - 1
List1.AddItem Printers(x).DeviceName
Next x
End Sub
Private Sub Command1_Click()
Dim Txt$, Prn$
If List1.SelCount = 1 Then
Prn$ = List1.List(List1.ListIndex)
If SetPrinterAsDefault(Prn) Then
Txt = Prn & " als Standartdrucker gesetzt !"
Else
Txt = "Der Versuch (" & Prn & ") fehlgeschlagen !"
End If
Else
Txt = "Bitte einen Drucker aus der Liste wählen !"
End If
MsgBox (Txt)
End Sub
Private Function PtrCtoVbString(Add&) As String
Dim sTemp As String * 512, x&
x = lstrcpy(sTemp, Add)
If (InStr(1, sTemp, Chr(0)) = 0) Then
PtrCtoVbString = ""
Else
PtrCtoVbString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1)
End If
End Function
Private Function SetPrinterAsDefault(ByVal DeviceName$) As Boolean
Call Initialize
If m_sCurrPrinterDevName <> DeviceName Then
SetPrinterAsDefault = Win95SetDefaultPrinter(DeviceName)
Else
SetPrinterAsDefault = True
End If
End Function
Private Sub Initialize()
Dim Buffer$, r&, x&, y&
Buffer = Space(8192)
r = GetProfileString("windows", "Device", "", Buffer, Len(Buffer))
If r Then
Buffer = Mid(Buffer, 1, r)
x = InStr(Buffer, ",")
m_sPrevPrinterDevName = Mid(Buffer, 1, x - 1)
y = InStr(x + 1, Buffer, ",")
m_sPrevPrinterDriver = Mid(Buffer, x + 1, y - x - 1)
m_sPrevPrinterPort = Mid(Buffer, y + 1)
Else
m_sPrevPrinterDevName = ""
m_sPrevPrinterDriver = ""
m_sPrevPrinterDevName = ""
End If
m_sCurrPrinterDevName = m_sPrevPrinterDevName
End Sub
Private Function Win95SetDefaultPrinter(DeviceName$) As Boolean
Dim Handle&
Dim pd As PRINTER_DEFAULTS
Dim x As Long
Dim need As Long
Dim pi5 As PRINTER_INFO_5
Dim LastError As Long
If DeviceName = "" Then
Win95SetDefaultPrinter = False
Exit Function
End If
pd.pDatatype = 0&
pd.DesiredAccess = PRINTER_ALL_ACCESS
x = OpenPrinter(DeviceName, Handle, pd)
If x = False Then
Win95SetDefaultPrinter = False
Exit Function
End If
x = GetPrinter(Handle, 5, ByVal 0&, 0, need)
ReDim t((need \ 4)) As Long
x = GetPrinter(Handle, 5, t(0), need, need)
If x = False Then
Win95SetDefaultPrinter = False
Exit Function
End If
pi5.pPrinterName = PtrCtoVbString(t(0))
pi5.pPortName = PtrCtoVbString(t(1))
pi5.Attributes = t(2)
pi5.DeviceNotSelectedTimeout = t(3)
pi5.TransmissionRetryTimeout = t(4)
pi5.Attributes = PRINTER_ATTRIBUTE_DEFAULT
x = SetPrinter(Handle, 5, pi5, 0)
If x = False Then
Win95SetDefaultPrinter = False
Exit Function
End If
Call ClosePrinter(Handle)
m_sCurrPrinterDevName = DeviceName
Win95SetDefaultPrinter = True
End Function