"Application.ActivePrinter"-Problem
31.07.2008 17:21:00
Bernd
Dank dieses Forums habe ich eine EINGABEMASKE in Betrieb genommen, mit welcher ich Angebote, Auftragsbestätigungen und Rechnungen erstellen und ausdrucken kann. Erstellte Angebote, Aufträge oder Rechnungen werden von drei verschiedenen PCs erstellt, gespeichert, gedruckt etc.
An allen PCs ist der gleiche LowBudget-Drucker angeschlossen ... der Samsung CLP-300.
An zwei Rechner funktioniert nachstehende Befehlszeile:
Application.ActivePrinter = "Samsung CLP-300 Series auf Ne00:"
An einem Rechner nicht:
Es müßte dort "Samsung CLP-300 Series auf Ne04" heißen (per Makro-Recorder ermittelt).
Was gibt es da für Möglichkeiten, so daß meine Eingabemaske.xls IMMER auf den direkt angeschlossenen Standard-Drucker eines jeden PCs druckt?
Es grüßt
Bernd Junker
PS 1: Hier mal ein Auszug des Moduls "DRUCKEN", welches per Button gestartet wird:
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
'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
PS 2: Und hier das gesamte Modul "DRUCKEN", welches per Button gestartet wird:
Option Explicit
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