Druckertausch - Makro läuft nicht mehr
Bernd
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