Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1092to1096
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Druckeneinstellungen mit VBA

Druckeneinstellungen mit VBA
Simon
Hallo an alle,
zuerst einmal finde ich es großartig das es so eine super homepageseite zu excel gibt!!! Leider kenne ich mit VBA nicht aus und ich habe ein Problem welches ich nicht über die normalen forumbeiträge lösen haben können:
ich habe mehrere Arbeitsblätter welche alle mit den selben Druckereinstellungen gedruckt werden sollen: Seite einrichten: Seitenformat A4, Ausgabeformat A3; Ausgabeformat: Broschürendruck, Sattelheftung
auch muss ich einen speziellen Drucker auswählen.
wenn ich alle diese Einstellungen über einen button wo diese VBA-einstellungen hinterlegt sind wäre das eine sehr große Arbeitserleichterung für mich.
Hoffentlich kann mir jemand den Pfad aufzeigen, schon im Vorhinein vielen vielen Dank!!
mfg simon

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Benutzer
Anzeige
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
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige