AW: Druckeneinstellungen mit VBA
10.08.2009 09:58:44
Tino
Hallo,
hier mal einen Code um den entsprechenden Drucker zu suchen diesen einzustellen und danach wieder auf den Standarddrucker umstellen. Den Namen (einen Teil davon) im Code anpassen. (siehe Kommentare)
Das mit der Seiteneinrichtung zeichnest Du dir am besten mit dem Rekorder auf.
Eventuell musst du den Code etwas aufräumen und fügst diesen wie im Beispiel gekennzeichnet an dieser Position ein.
Option Explicit
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias _
"RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, _
ByVal lpValueName As String, lpcbValueName As Long, ByVal _
lpReserved As Long, lpType As Long, lpData As Byte, _
lpcbData As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" (ByVal hKey As Long, _
ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_QUERY_VALUE = &H1
Private Const READ_CONTROL = &H20000
Private Const KEY_READ = (READ_CONTROL Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY)
Private Const HKEY_CURRENT_USER = &H80000001
Private Const Schlüsselname = "Software\Microsoft\Windows NT\CurrentVersion\Devices\"
Private Function FindDrucker(ByVal sDruckerName$) As String
Dim dummy, hwndSchlüssel&
Dim Länge&, lngIndex&
Dim strFeld As String, lngLänge As Long
Dim arrPuffer() As Byte, strPuffer As String
Dim lngArrLänge As Long, lngPortlänge As Long
Dim Drucker As String
dummy = RegOpenKeyEx(HKEY_CURRENT_USER, _
Schlüsselname, 0&, KEY_READ, hwndSchlüssel)
If dummy <> 0 Then MsgBox "Falscher Schlüssel": Exit Function
strFeld = String(1024, 0)
lngLänge = 1023
Redim arrPuffer(0 To 1000)
Do While RegEnumValue(hwndSchlüssel, lngIndex, _
strFeld, lngLänge, 0&, ByVal 0&, ByVal 0&, ByVal 0&) = 0
Drucker = Left$(strFeld, lngLänge) & " auf "
lngArrLänge = 1024
RegEnumValue hwndSchlüssel, lngIndex, strFeld, _
lngLänge, 0&, 0&, arrPuffer(0), lngArrLänge
strPuffer = (StrConv(arrPuffer, vbUnicode))
lngPortlänge = InStr(1, strPuffer, ":") - InStr(1, strPuffer, ",")
strPuffer = Mid$(strPuffer, InStr(1, strPuffer, ":") - 4, lngPortlänge)
strPuffer = Replace(strPuffer, ",", "")
strPuffer = IIf(Right$(strPuffer, 1) = ":", strPuffer, strPuffer & ":")
Drucker = Drucker & strPuffer
If Drucker Like sDruckerName Then FindDrucker = Drucker: Exit Do
lngIndex = lngIndex + 1
strFeld = String(1024, 0)
lngLänge = 1023
Loop
dummy = RegCloseKey(hwndSchlüssel)
End Function
Sub TestDruckerUmstellen()
Dim sAktuellerDrucker As String
Dim sDrucker As String
'aktuellen Drucker in einem String merken
sAktuellerDrucker = Application.ActivePrinter
'Drucker Suchen, Platzhalter verwenden
sDrucker = FindDrucker("*Samsung CLX*") 'hier den Drucker eintragen (einen Teil davon)
If sDrucker <> "" Then
Application.ActivePrinter = sDrucker
End If
'hier Dein Code für die Seiteneinrichtung und den Ausdruck
'...
'...
'Drucker wieder zurückstellen, sollte er umgestellt sein
If sDrucker <> "" Then
Application.ActivePrinter = sAktuellerDrucker
End If
End Sub
Gruß Tino