Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1136to1140
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

Drucker NE00 Name bzw. Variable für alle Blätter

Drucker NE00 Name bzw. Variable für alle Blätter
Timonski
Servus
ich hätte da mal ne ...
Problem + Frage = Bitte => hoffentlich Lösung ;-) und zwar:
Ich muß immer eine Tabelle auf 2 verschiedenen Druckern ausdrucken.
die Drucker haben immer so komische Bezeichnungen z.b. KONICA MINOLTA magicolor 3100 auf Ne04:
das "auf Ne04" ändert sich ab und zu, dann muß ich in meinem VBA Code alle Ne04 auf Ne0X umbenennen und den zweiten Drucker natürlich auch.
Lösung 1: wäre mir am liebsten... Excel holt sich automatisch die NE Nummern von dem Drucker,
Lösung 2:
was mir jetzt gerade vorschwebt, ist für jeden Drucker eine VARIABLE zu machen, die in "DIESE ARBEITSMAPPE" steht, oder wo sie halt stehen muß, damit sie auf allen Blätter funktioniert, damit ich nur noch einen Wert ändern muß
DRUCKER1 = KONICA MINOLTA magicolor 3100 auf Ne04:
DRUCKER2 = BEISPIELDRUCKER auf Ne05:
und bei allen VBA Codes dann nur noch
Application.ActivePrinter = DRUCKER1 
steht...
ich bedanke mich schon mal für eure Hilfe
Timonski

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Drucker NE00 Name bzw. Variable für alle Blätter
10.02.2010 11:49:32
Ewald
Hallo Timonski
Ich habe 2 Drucker, die ich so ansteuere, indem ich dieses beiden Makros in der Personl.xls-Datei in ein Modul geschrieben habe und im Excel-Menü 2 Button einsetzte, die diesen Code ausführen.
Somit bin ich unabhängig, welcher Drucker der Standard ist, dieser wird dann automatisch wieder zurückgestellt. Ob mein Vorschlag bei allen Office-Versionen funktioniert, weiss ich nicht. Ich habe Windows XP und Excel 2002 SP3. Die Bezeichnungen Ne..xx dürften sich im Normalfall selten ändern?
Sub CanonDruck()
Dim oldprinter As Variant
oldprinter = ActivePrinter
ActivePrinter = "Canon iP4200 auf Ne05:"
ActiveSheet.PrintOut
ActivePrinter = oldprinter
End Sub

Sub LexmarkDruck()
Dim oldprinter As Variant
oldprinter = ActivePrinter
ActivePrinter = "Lexmark Z65 auf Ne02:"
ActiveSheet.PrintOut
ActivePrinter = oldprinter
End Sub
Gruss Ewald
Anzeige
AW: Drucker NE00 Name bzw. Variable für alle Blätter
10.02.2010 20:37:29
Tino
Hallo,
versuche mal so
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

'1. Drucker Suchen, Platzhalter verwenden 
sDrucker = FindDrucker("*KONICA MINOLTA magicolor 3100*")

If sDrucker <> "" Then
    Application.ActivePrinter = sDrucker
        'hier Dein Code für den Ausdruck 
        '... 
        '... 
Else
    MsgBox sDrucker & " nicht gefunden"
End If
   
    



'2. Drucker Suchen, Platzhalter verwenden 
sDrucker = FindDrucker("*BEISPIELDRUCKER*")
If sDrucker <> "" Then
    Application.ActivePrinter = sDrucker
        'hier Dein Code für den Ausdruck 
        '... 
        '... 
Else
    MsgBox sDrucker & " nicht gefunden"
End If

'Drucker wieder zurückstellen, sollte er umgestellt sein 
If sDrucker <> sAktuellerDrucker Then
 Application.ActivePrinter = sAktuellerDrucker
End If

End Sub
Gruß Tino
Anzeige

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige