Druckertausch - Makro läuft nicht mehr

Hallo,
ich habe meinen Samsung CLP-300 gegen einen CLP-310 getauscht und nun kann ich nicht mehr drucken. Der Drucker ansich funktioniert, aber mein per Button aufzurufendes DRUCKEN-Makro startet nicht.
Infos:
Der neue Drucker ist der Standard-Drucker
In der 11. Zeile (Application.ActivePrinter = "Samsung CLP-300 Series auf Ne00:") habe ich CLP-300 schon gegen CLP-310 getauscht, aber dennoch wird nicht gedruckt.
Der Druck über Datei/Drucken bzw. das Druck-Icon funktioniert.
Weiß jemand, was ich am Makro ändern muß?
Ein Problem ist auch, daß die Datei mehrere Personen nutzen bzw. ausdrucken. Ich hatte vor etlichen Monaten extra 5 gleiche Drucker gekauft und stehe nun zusätzlich vor dem Problem, daß drei Personen noch einen CLP-300 haben, zwei Personen aber einen CLP-310 bekommen haben, da die alten Drucker "auf" waren.
Vielleicht kann mir jemand helfen ?!?
Schöne Grüße
Junker


Sub Drucken()
Dim objWks As Worksheet, strAktiverDrucker As String, objZelleKopie As Range
Dim lngFarbeKopie As Long
On Error GoTo Fehler
Set objWks = Worksheets("Angebot")
Set objZelleKopie = objWks.Range("F26") 'Zelle zur Kennzeichnung der Kopie
lngFarbeKopie = objZelleKopie.Interior.ColorIndex 'Originalfarbe merken
'Drucken
strAktiverDrucker = Application.ActivePrinter 'aktiven Druckermerken
'Drucker für Ausgabe setzen, falls nicht der Aktive Drucker genommen werden soll
Application.ActivePrinter = "Samsung CLP-300 Series auf Ne00:"
If objWks.Shapes("Kontrollkästchen 5").ControlFormat.Value = 1 Then
'Kunden-Exemplar
'   objWks.PrintPreview
objWks.PrintOut
End If
If objWks.Shapes("Kontrollkästchen 25").ControlFormat.Value = 1 Then
'Kopie - Kunde
objZelleKopie = "K O P I E"
'   objWks.PrintPreview
objWks.PrintOut
End If
If objWks.Shapes("Kontrollkästchen 8").ControlFormat.Value = 1 Then
'Kopie - Produktion
objZelleKopie.Interior.ColorIndex = 6 'gelb
objZelleKopie = "KOPIE - Produktion"
'   objWks.PrintPreview
objWks.PrintOut
End If
If objWks.Shapes("Kontrollkästchen 29").ControlFormat.Value = 1 Then
'Kopie - Produktion
objZelleKopie.Interior.ColorIndex = 3 'rot
objZelleKopie = "KOPIE - Tourenplanung"
'   objWks.PrintPreview
objWks.PrintOut
End If
If objWks.Shapes("Kontrollkästchen 28").ControlFormat.Value = 1 Then
'Kopie - Produktion
objZelleKopie.Interior.ColorIndex = 40 'hellgrau
objZelleKopie = "KOPIE - Ablage/Koffer"
'   objWks.PrintPreview
objWks.PrintOut
End If
If objWks.Shapes("Kontrollkästchen 31").ControlFormat.Value = 1 Then
'Kopie - Produktion
objZelleKopie.Interior.ColorIndex = 4 'grün
objZelleKopie = "KOPIE - Provisionsabrechn."
'   objWks.PrintPreview
objWks.PrintOut
End If
If objWks.Shapes("Kontrollkästchen 32").ControlFormat.Value = 1 Then
'Kopie - Produktion
objZelleKopie.Interior.ColorIndex = 4 'grün
objZelleKopie = "KOPIE - Steuerberater"
'   objWks.PrintPreview
objWks.PrintOut
End If
If objWks.Shapes("Kontrollkästchen 34").ControlFormat.Value = 1 Then
'Kopie - Produktion
objZelleKopie.Interior.ColorIndex = 4 'grün
objZelleKopie = "KOPIE - Zahlungsverkehr"
'   objWks.PrintPreview
objWks.PrintOut
End If
If objWks.Shapes("Kontrollkästchen 6").ControlFormat.Value = 1 Then
'Kopie - Vertrieb
objZelleKopie.Interior.ColorIndex = 37 'hellblau
objZelleKopie = "KOPIE - Vertrieb"
'   objWks.PrintPreview
objWks.PrintOut
End If
If objWks.Shapes("Kontrollkästchen 36").ControlFormat.Value = 1 Then
'Kopie - Vertrieb
objZelleKopie.Interior.ColorIndex = 33 'blau
objZelleKopie = "KOPIE - Lieferschein etc."
'   objWks.PrintPreview
objWks.PrintOut
End If
If objWks.Shapes("Kontrollkästchen 7").ControlFormat.Value = 1 Then
'Exemplar - Allgemeine Ablage
objZelleKopie.Interior.ColorIndex = 33 'blau
objZelleKopie = "KOPIE - Gesamt-Ordner"
'   objWks.PrintPreview
objWks.PrintOut
End If
'  If objWks.Shapes("Kontrollkästchen 75").ControlFormat.Value = 1 Then
'    'PDF-Datei erstellen
'    'FarbeZelle zurücksetzen
'    objZelleKopie.Interior.ColorIndex = lngFarbeKopie
'    objZelleKopie.MergeArea.ClearContents
'    'PDF-Drucker auswählen
'    Application.ActivePrinter = "Acrobat PDFWriter auf LPT1:"
'    objWks.PrintOut
'  End If
Fehler:
If Err.Number  0 Then
If Err.Number = 1004 Then
'do nothing
Else
MsgBox "Fehler Nr. " & Err.Number & " ist aufgetreten!" & vbLf & Err.Description
End If
End If
'FarbeZelle zurücksetzen
If Not objZelleKopie Is Nothing Then
objZelleKopie.Interior.ColorIndex = lngFarbeKopie
objZelleKopie.MergeArea.ClearContents
End If
'Drucker zurücksetzen
If strAktiverDrucker  "" Then Application.ActivePrinter = strAktiverDrucker
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

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 TestDruckerSuchen() Dim sDrucker As String 'Drucker Suchen, Platzhalter verwenden sDrucker = FindDrucker("*CLP-310*") If sDrucker <> "" Then MsgBox sDrucker Else MsgBox "Drucker nicht gefunden!" End If End Sub

Hallo,
wenn es Deinem Arbeitgeber lieber ist neue Drucker zu kaufen um danach festzustellen,
dass es immer noch nicht geht.
Prinzipiell kann ich ja drucken.
Bloß die Eingabemaske wird nun an zwei verschiedenen Druckern benutzt:
Samsung CLP-300 und Samsung CLP-310
Per VBA müßte ja nur der Standard-Drucker automatisch benutzt werden.
strAktiverDrucker = Application.ActivePrinter 'aktiven Druckermerken
'Drucker für Ausgabe setzen, falls nicht der Aktive Drucker genommen werden soll
Application.ActivePrinter = "Samsung CLP-300 Series auf Ne00:"
Wenn ich die letzte Zeile löschen, wird nichts gedruckt.
Ändere ich CLP-300 auf CLP-310, könnte ich drucken, aber dann die anderen nicht mehr
----------
"Interessant, gestern war er doch noch auf Ne05; geändert wurde aber nichts"
Wie kannst Du den Druckerport ändern,
dieser wird doch normalerweise beim Start automatisch vergeben.
Ich habe nichts geändert. Vielleicht liegt es ja daran, daß ich gestern den neuen Drucker angeschlossen habe und seitdem den Rechner nicht neu gestartet hatte. Heute morgen ist der Drucker jedenfalls am Druckport Ne00
----------
Wo bekommst Du die Fehlermeldung in welcher Zeile?
Im Modul 2 in Zeile 17
Set objWks = Worksheets("Angebot")
Mein logisches Verständnis sagt mir, daß das eben logisch sein muß, denn ich habe ja kein Blatt mit dem Namen "Angebot" ... zumindest nicht in Deiner Beispielarbeitsmappe.
----------
Gruß Tino
Danke, daß Du noch dabie bist ;-)

Beliebteste Forumthreads (12 Monate)

Druckertausch - Makro läuft nicht mehr

32 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

32
Beiträge zum Forumthread

Beiträge zu diesem Forumthread