Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1736to1740
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1736to1740
1736to1740
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.

ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 15:32:00
Chris
Hallo zusammen,
nun wende ich mich doch nach Ratlosigkeit an die Profis.
Ich habe eine Datei aus der Daten mittels Auswahl gedruckt werden auf 2 verschiedenen Druckern die der User zum Anfang auswählt. ( A4 Drucker und Label Drucker ).
Die Datei läuft in mehreren Standorten auf verschiedenen PC und das auch super ohne Probleme.
bis auf ein Standort und egal bei welchem PC dort. Ich hatte mich auch schon mit der IT in Verbindung gesetzt die aber der Meinung ist das es an der Programmierung liegt.
Das Problem:
Beim drucken verschiedener Aufträge wird geprüft ob (je nach Auftrag) Label gedruckt werden oder nicht.
Wenn das Makro auf den gewählten Label Drucker springt weil die Bedingung erfüllt sind kommt nach dem Druck der Label "Activeprinter = sd" (A4 Drucker) wo das Makro jedes mal abbricht. gehe ich in den Debugger und drücke an der Stelle F8 wird der Befehl ausgeführt und ich kann das Makro mit Play weiter laufen lassen.
ich habe auch schon versucht den Befehl an anderer stelle einzubauen aber ohne Erfolg.
Das Makro will dort einfach nicht von dem Label Drucker auf den A4 zurück.
Bezeichnung des Druckers sowie Anschluss sind an dem punkt vorhanden.
Datei des Codes als TXT im Anhang sowie ein Bild der Datei mit weniger / geänderten Daten.
Bild der Tabelle: Userbild
VBA Code in txt: https://www.herber.de/bbs/user/135071.txt
Abbrechen des Makros erfolgt aktuell nach dem Punkt wo die Felgenaufkleber gedruckt werden.
Frage: wie umgehe ich dort den Fehler für diesen Standort.
Liegt es an der Programmierung.
was kann ich einbauen oder ändern das es läuft.
PS: die Drucker Zuweisung kann ich nicht anders gestalten da die Tabellen auf vielen PC läuft mit vielen unterschiedlichen Druckern somit muss dem USER die Möglichkeit gegeben sein die beiden Drucker vor dem druck auszuwählen.
Ich hoffe habe es so gut wie möglich erklärt und es kann mir jemand helfen.
LG
CHRIS

24
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 15:41:34
Chris
Hier nochmal der Code, ich habe die stelle (fast am ende) fett markiert.

Option Explicit
Dim sd As String
Dim ld As String
Sub Drucken_NEU()
Dim a As Integer
Dim l As Integer
Dim C As Range
Dim su As Integer
Application.ScreenUpdating = False
Worksheets("Aliste").Visible = True
Worksheets("Radmontage Formular").Visible = True
Worksheets("Felgen Aufkleber").Visible = True
Sheets("Aliste").Range("A2:J1000").ClearContents
Worksheets("overview").Activate
'Prüfen ob Druckerauswahl erfolgte wenn nicht Druckerauswahl
If (sd = "") Then
MsgBox "Bitte A4 Standarddrucker wählen"
Application.Dialogs(xlDialogPrinterSetup).Show
sd = Application.ActivePrinter
MsgBox "Bitte Labeldrucker auswählen"
Application.Dialogs(xlDialogPrinterSetup).Show
ld = Application.ActivePrinter
End If
Application.ActivePrinter = sd
l = 2
For Each C In Selection
su = 0
a = C.Row
If UCase(Worksheets("overview").Cells(a, 12).Value) = "X" Or UCase(Worksheets("overview"). _
Cells(a, 13).Value) = "X" Or UCase(Worksheets("overview").Cells(a, 14).Value) = "X" Or _
UCase(Worksheets("overview").Cells(a, 15).Value) = "X" Or UCase(Worksheets("overview"). _
Cells(a, 16).Value) = "X" Or UCase(Worksheets("overview").Cells(a, 17).Value) = "X" Or UCase(Worksheets("overview").Cells(a, 18).Value) = "X" Then
If UCase(Worksheets("overview").Cells(a, 8).Value) = "X" Then su = su + 1
If UCase(Worksheets("overview").Cells(a, 9).Value) = "X" Then su = su + 1
If UCase(Worksheets("overview").Cells(a, 10).Value) = "X" Then su = su + 1
If UCase(Worksheets("overview").Cells(a, 11).Value) = "X" Then su = su + 1
Worksheets("overview").Cells(a, 4) = su
If IsEmpty(C.Offset(0, 26).Value) Or IsEmpty(C.Offset(0, 28).Value) Then
If UCase(Worksheets("overview").Cells(a, 12).Value) = "X" Then
C.Offset(0, 26) = Cells(2, 12)
C.Offset(0, 27) = C.Offset(0, 0) & Cells(2, 12)
If UCase(Worksheets("overview").Cells(a, 19).Value) = "X" Then
C.Offset(0, 28) = Cells(2, 19)
C.Offset(0, 29) = C.Offset(0, 0) & Cells(2, 19)
Else
If UCase(Worksheets("overview").Cells(a, 20).Value) = "X" Then
C.Offset(0, 28) = Cells(2, 20)
C.Offset(0, 29) = C.Offset(0, 0) & Cells(2, 20)
Else
If UCase(Worksheets("overview").Cells(a, 21).Value) = "X" Then
C.Offset(0, 28) = Cells(2, 21)
C.Offset(0, 29) = C.Offset(0, 0) & Cells(2, 21)
Else
If UCase(Worksheets("overview").Cells(a, 22).Value) = "X" Then
C.Offset(0, 28) = Cells(2, 22)
C.Offset(0, 29) = C.Offset(0, 0) & Cells(2, 22)
Else
End If
End If
End If
End If
Else
If UCase(Worksheets("overview").Cells(a, 13).Value) = "X" Then
C.Offset(0, 26) = Cells(2, 13)
C.Offset(0, 27) = C.Offset(0, 0) & Cells(2, 13)
C.Offset(0, 28) = Cells(2, 13)
C.Offset(0, 29) = C.Offset(0, 0) & Cells(2, 13)
Else
If UCase(Worksheets("overview").Cells(a, 14).Value) = "X" Then
C.Offset(0, 26) = Cells(2, 14)
C.Offset(0, 27) = C.Offset(0, 0) & Cells(2, 14)
C.Offset(0, 28) = Cells(2, 14)
C.Offset(0, 29) = C.Offset(0, 0) & Cells(2, 14)
Else
If UCase(Worksheets("overview").Cells(a, 15).Value) = "X" Then
C.Offset(0, 26) = Cells(2, 15)
C.Offset(0, 27) = C.Offset(0, 0) & Cells(2, 15)
C.Offset(0, 28) = Cells(2, 15)
C.Offset(0, 29) = C.Offset(0, 0) & Cells(2, 15)
Else
If UCase(Worksheets("overview").Cells(a, 16).Value) = "X" Then
C.Offset(0, 26) = Cells(2, 16)
C.Offset(0, 27) = C.Offset(0, 0) & Cells(2, 16)
C.Offset(0, 28) = Cells(2, 16)
C.Offset(0, 29) = C.Offset(0, 0) & Cells(2, 16)
Else
If UCase(Worksheets("overview").Cells(a, 17).Value) = "X" Then
C.Offset(0, 26) = Cells(2, 17)
C.Offset(0, 27) = C.Offset(0, 0) & Cells(2, 17)
C.Offset(0, 28) = Cells(2, 17)
C.Offset(0, 29) = C.Offset(0, 0) & Cells(2, 17)
Else
If UCase(Worksheets("overview").Cells(a, 18).Value) = "X" Then
C.Offset(0, 26) = Cells(2, 18)
C.Offset(0, 27) = C.Offset(0, 0) & Cells(2, 18)
C.Offset(0, 28) = Cells(2, 18)
C.Offset(0, 29) = C.Offset(0, 0) & Cells(2, 18)
End If
End If
End If
End If
End If
End If
End If
End If
Worksheets("Aliste").Cells(l, 1) = Worksheets("overview").Cells(a, 1) 'Kennzeichen
Worksheets("Aliste").Cells(l, 2) = Worksheets("overview").Cells(a, 3) ' Satznummer
Worksheets("Aliste").Cells(l, 3) = Worksheets("overview").Cells(a, 28) 'Lagerpaltz
Worksheets("Aliste").Cells(l, 4) = Worksheets("overview").Cells(a, 2) 'Vin
Worksheets("Aliste").Cells(l, 5) = Worksheets("overview").Cells(a, 27) 'Termin
Worksheets("Aliste").Cells(l, 6) = Worksheets("overview").Cells(a, 29) 'Service
Worksheets("Aliste").Cells(l, 7) = Worksheets("overview").Cells(a, 8) 'VL
Worksheets("Aliste").Cells(l, 8) = Worksheets("overview").Cells(a, 9) 'VR
Worksheets("Aliste").Cells(l, 9) = Worksheets("overview").Cells(a, 10) 'HL
Worksheets("Aliste").Cells(l, 10) = Worksheets("overview").Cells(a, 11) 'HR
Worksheets("Radmontage Formular").Cells(13, 7) = Worksheets("overview").Cells(a, 1) ' _
Kennzeichen
Worksheets("Radmontage Formular").Cells(13, 5) = Worksheets("overview").Cells(a, 2) 'Vin
Worksheets("Radmontage Formular").Cells(9, 5) = Worksheets("overview").Cells(a, 3) '  _
Satznummer
Worksheets("Radmontage Formular").Cells(11, 5) = "*" & Worksheets("overview").Cells(a, 3) &  _
"*" ' Satznummer code
Worksheets("Radmontage Formular").Cells(12, 5) = Worksheets("overview").Cells(a, 28) ' _
Lagerpaltz
Worksheets("Radmontage Formular").Cells(10, 5) = Worksheets("overview").Cells(a, 4) 'Menge
Worksheets("Radmontage Formular").Cells(14, 5) = Worksheets("overview").Cells(a, 27) ' _
Termin
Worksheets("Radmontage Formular").Cells(3, 1) = Worksheets("overview").Cells(a, 29) ' _
Service
Worksheets("Radmontage Formular").Cells(1, 9) = Worksheets("overview").Cells(a, 8) 'VL
Worksheets("Radmontage Formular").Cells(2, 9) = Worksheets("overview").Cells(a, 9) 'VR
Worksheets("Radmontage Formular").Cells(3, 9) = Worksheets("overview").Cells(a, 10) 'HL
Worksheets("Radmontage Formular").Cells(4, 9) = Worksheets("overview").Cells(a, 11) 'HR
Worksheets("Radmontage Formular").Cells(55, 1) = "*" & Worksheets("overview").Cells(a, 30) & _
"*" 'Service code
Worksheets("Radmontage Formular").Cells(14, 7) = Worksheets("overview").Cells(a, 26)  ' _
Termin
Worksheets("Radmontage Formular").Cells(53, 1) = Worksheets("overview").Cells(a, 6) ' _
Bemerkung
Worksheets("Radmontage Formular").Cells(9, 7) = Date 'Datum
Sheets("Radmontage Formular").PrintOut Copies:=1
C.Interior.ColorIndex = 42
If UCase(Worksheets("overview").Cells(a, 12).Value) = "X" Then
Application.ActivePrinter = ld
Worksheets("Felgen Aufkleber").Cells(3, 1) = Worksheets("overview").Cells(a, 6) ' _
Bemerkung
Worksheets("Felgen Aufkleber").Cells(4, 2) = Worksheets("overview").Cells(a, 3) '  _
Satznummer
Worksheets("Felgen Aufkleber").Cells(6, 2) = Worksheets("overview").Cells(a, 28) ' _
Lagerpaltz
Worksheets("Felgen Aufkleber").Cells(5, 3) = ""
If Not IsEmpty(Worksheets("overview").Cells(a, 27)) Then Worksheets("Felgen Aufkleber"). _
Cells(5, 3) = Worksheets("overview").Cells(a, 27) - 5 'Termin
'Worksheets("Felgen Aufkleber").Cells(5, 3) = Worksheets("overview").Cells(a, 27) - 5 ' _
Termin
If UCase(Worksheets("overview").Cells(a, 8).Value) = "X" Then
Worksheets("Felgen Aufkleber").Cells(5, 2) = "VL"
Sheets("Felgen Aufkleber").PrintOut Copies:=4
End If
If UCase(Worksheets("overview").Cells(a, 9).Value) = "X" Then
Worksheets("Felgen Aufkleber").Cells(5, 2) = "VR"
Sheets("Felgen Aufkleber").PrintOut Copies:=4
End If
If UCase(Worksheets("overview").Cells(a, 10).Value) = "X" Then
Worksheets("Felgen Aufkleber").Cells(5, 2) = "HL"
Sheets("Felgen Aufkleber").PrintOut Copies:=4
End If
If UCase(Worksheets("overview").Cells(a, 11).Value) = "X" Then
Worksheets("Felgen Aufkleber").Cells(5, 2) = "HR"
Sheets("Felgen Aufkleber").PrintOut Copies:=4
End If
Application.ActivePrinter = sd
C.Interior.ColorIndex = 6
End If
End If
l = l + 1
Next
Worksheets("Aliste").PrintOut Copies:=1
Worksheets("Aliste").Visible = False
Worksheets("Radmontage Formular").Visible = False
Worksheets("Felgen Aufkleber").Visible = False
Application.ScreenUpdating = True
End Sub

Anzeige
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 17:38:26
onur
Bildchen und Code als Text bringt nix.
Wo ist die Datei denn?
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 18:31:57
Chris
Hallo onur,
Im Anhang eine Test Datei die sich nur auf das drucken bezieht.
https://www.herber.de/bbs/user/135075.xlsm
LG
Chris
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 18:47:18
onur
Mit welcher Fehlermeldung wird abgebrochen und wo genau?
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 19:18:28
Chris
es wird bei Aktiveprinter = sd abgebrochen, sobald der aktive Printer ld zugewiesen war.
ich denke auch bei Dir wird das Makro laufen nur in dem einen Standort nicht.
Die Ausgewählten Drucker im Standort laufen und drucken sonst alles. aufgrund des Speicher Hinweises wurde auch schon der Arbeitsspeicher zum testen hoch gesetzt.
Ich bin echt Ratlos.
Userbild
Userbild
Danke schon mal für deine Mühe.
LG
Chris
Anzeige
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 20:25:44
onur
und der HP-LaserJet ist der DIN A4-Drucker?
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 20:28:35
onur
Und das Alles passiert, nachdem alle Labels korrekt ausgedruckt wurden?
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 20:41:31
Chris
ja der HP ist dort der A4 Drucker und alle Label werden normal gedruckt.
was mich halt echt wundert ist das es in jedem anderen Standort läuft.
und dort an diesem punkt anhält aber so wie ich im Debugger denn punkt mit f8 von Hand ausführe es auch weiter läuft danach.
Die Drucker sind alles Netzwerkdrucker was aber auch in anderen Standorten der Fall ist.
In dem gleichen Standort gibt es noch ein Internes getrenntes anderes Netzwerk worüber ich es auch versucht hatte und da lief es.
Laut unserer IT liegt es aber nicht am Netzwerk/ Drucker, aber naja....
LG
Chris
Anzeige
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 20:46:52
onur
Baue doch mal eine Pause von 10 sec ein (direkt vor "Application.ActivePrinter = sd") - und zwar so: 
ti = Timer
While Timer - ti

AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 20:59:26
Chris
Genau der gleiche Fehler mit der gleichen Fehlermeldung nur mit 10 Sekunden Verspätung.
Ich weis unschön mit dem Dim direkt drüber aber zum testen reichte es.
Userbild
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 21:26:14
onur
ist der Labeldrucker bereits fertig, wenn die Meldung kommt, oder druckt er noch?
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 21:45:07
Chris
Die frage kann ich Dir so genau nicht beantworten da ich dort nicht Vorort bin.
aber ich gehe zu 99 Prozent davon aus das der Label Drucker noch am drucken ist wenn der Befehl kommt.
bei den 10 Sekunden warten hätte er aber fertig sein müssen,da in dem Test nur 4 Test Label von mir gerade in dem Standort gedruckt wurden.
Ich hatte es auch schon mit Application.Wait versucht ohne Erfolg.
Der Kollege wird sich freuen am Montag über so viel Müll xD
LG
Chris
Anzeige
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 21:48:11
onur
Sind das Zebra-Drucker?
Teste doch sicherheitshalber mal mit 30 sec.
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 22:01:26
Chris
gleicher Fehler weiterhin.
der Labeldrucker ist ein CAB EOS4/300 aber den gleichen habe ich auch in meinem Standort wo alles läuft.
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 22:04:46
onur
Das einzige, was mir noch einfällt: Schliesse ihn lokal an.
Was mich iritiert ist, ist die Tatsache, dass der Code anhält und diese Fehlermeldung ausspuckt, obwohl auf dem HP-Drucker an dieser Stelle ja nix ausgedruckt werden soll (erst in den Zeilen drunter).
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 22:24:04
Chris
darüber druckt er die Label auf dem Label Drucker. und stimmt da wo er anhält sage ich ja nur das der Standartdrucker wieder der HP (A4) Drucker sein soll. Lokal hatte ich auch schon versucht als ich dort Vorort war sowie Treiber neu installiert etc.
keine Veränderung.
Vielleicht kommt ja noch ein blitz Gedanke.
LG
Chris
Anzeige
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 22:28:50
onur
"wo er anhält sage ich ja nur das der Standartdrucker wieder der HP (A4) Drucker sein soll" - Aber, da es innerhaslb der Schleife 
For Each C In Selection

geschieht, tust du es wieder und wieder und wieder - der ActivePrinter wird dauernd hin und her umgestellt.
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 22:11:38
onur
Noch was: es wir doch innerhalb der Schleife nix auf dem A4-Drucker gedruckt - oder?
Dann gehört 
Application.ActivePrinter = sd

HINTER 
Next

AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 22:27:10
Chris
doch in der schleife läuft er die Auswahl ab wenn mehrere Aufträge ausgedruckt werden sollen läuft er dies in der schleife ab und je nach Auftrag druckt er das passende Formular und wenn notwendig die Label mit dazu.
hinter das next kann ich es demnach nicht schreiben
Anzeige
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 22:37:05
onur
Innerhalb der Schleife wird doch nix auf dem A4-Drucker gedruckt - ich dehe jedenfalls nichts (was nicht einfach ist, da dein Code nicht richtig strukturiert aufgebaut (nicht wild einrücken, sondern alles, was innerhalb einer Schleife ist) und deswegen nicht einfach zu lesen ist.
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 22:53:15
Chris
Ich hab dir mal ein paar Sachen dazu geschrieben.
grober Ablauf nachdem die Auswahl getroffen wurde werden verschiedenen Bedingungen geprüft woraus sich das Montageformular füllt mit Überschrift passend zum ausgewählten Auftrag.
das Formular wird dann auf dem A4 Drucker (sd) gedruckt.
danach wird geprüft ob es sich um eine Felgeninstandsetzung handelt wenn nicht wird gesprungen bis next.
wenn doch wird der Drucker auf Label Drucker (ld) umgestellt.
es wird geprüft anhand der positionskreuze (VR/VL/HL/HR) Welche Label gedruckt werden und das Tabellenblatt passend gefüllt pro Position und wird gedruckt. 4 Label pro Position.
danach wird der aktive Drucker wieder auf den A4 (sd) Drucker gesetzt. 
Option Explicit
Dim sd As String
Dim ld As String
Sub Drucken_NEU()
Dim a As Integer
Dim l As Integer
Dim C As Range
Dim su As Integer
Application.ScreenUpdating = False
Worksheets("Aliste").Visible = True
Worksheets("Radmontage Formular").Visible = True
Worksheets("Felgen Aufkleber").Visible = True
Sheets("Aliste").Range("A2:J1000").ClearContents
Worksheets("overview").Activate
'Pr?fen ob Druckerauswahl erfolgte wenn nicht Druckerauswahl
If (sd = "") Then
MsgBox "Bitte A4 Standarddrucker w?hlen"
Application.Dialogs(xlDialogPrinterSetup).Show
sd = Application.ActivePrinter
MsgBox "Bitte Labeldrucker ausw?hlen"
Application.Dialogs(xlDialogPrinterSetup).Show
ld = Application.ActivePrinter
End If
Application.ActivePrinter = sd
l = 2
For Each C In Selection  ' Beginn der schleife
su = 0
a = C.Row
If UCase(Worksheets("overview").Cells(a, 12).Value) = "X" Or UCase(Worksheets("overview"). _
Cells(a, 13).Value) = "X" Or UCase(Worksheets("overview").Cells(a, 14).Value) = "X" Or _
UCase(Worksheets("overview").Cells(a, 15).Value) = "X" Or UCase(Worksheets("overview"). _
Cells(a, 16).Value) = "X" Or UCase(Worksheets("overview").Cells(a, 17).Value) = "X" Or UCase(Worksheets("overview").Cells(a, 18).Value) = "X" Then
If UCase(Worksheets("overview").Cells(a, 8).Value) = "X" Then su = su + 1
If UCase(Worksheets("overview").Cells(a, 9).Value) = "X" Then su = su + 1
If UCase(Worksheets("overview").Cells(a, 10).Value) = "X" Then su = su + 1
If UCase(Worksheets("overview").Cells(a, 11).Value) = "X" Then su = su + 1
Worksheets("overview").Cells(a, 4) = su
If IsEmpty(C.Offset(0, 26).Value) Or IsEmpty(C.Offset(0, 28).Value) Then
If UCase(Worksheets("overview").Cells(a, 12).Value) = "X" Then
C.Offset(0, 26) = Cells(2, 12)
C.Offset(0, 27) = C.Offset(0, 0) & Cells(2, 12)
If UCase(Worksheets("overview").Cells(a, 19).Value) = "X" Then
C.Offset(0, 28) = Cells(2, 19)
C.Offset(0, 29) = C.Offset(0, 0) & Cells(2, 19)
Else
If UCase(Worksheets("overview").Cells(a, 20).Value) = "X" Then
C.Offset(0, 28) = Cells(2, 20)
C.Offset(0, 29) = C.Offset(0, 0) & Cells(2, 20)
Else
If UCase(Worksheets("overview").Cells(a, 21).Value) = "X" Then
C.Offset(0, 28) = Cells(2, 21)
C.Offset(0, 29) = C.Offset(0, 0) & Cells(2, 21)
Else
If UCase(Worksheets("overview").Cells(a, 22).Value) = "X" Then
C.Offset(0, 28) = Cells(2, 22)
C.Offset(0, 29) = C.Offset(0, 0) & Cells(2, 22)
Else
End If
End If
End If
End If
Else
If UCase(Worksheets("overview").Cells(a, 13).Value) = "X" Then
C.Offset(0, 26) = Cells(2, 13)
C.Offset(0, 27) = C.Offset(0, 0) & Cells(2, 13)
C.Offset(0, 28) = Cells(2, 13)
C.Offset(0, 29) = C.Offset(0, 0) & Cells(2, 13)
Else
If UCase(Worksheets("overview").Cells(a, 14).Value) = "X" Then
C.Offset(0, 26) = Cells(2, 14)
C.Offset(0, 27) = C.Offset(0, 0) & Cells(2, 14)
C.Offset(0, 28) = Cells(2, 14)
C.Offset(0, 29) = C.Offset(0, 0) & Cells(2, 14)
Else
If UCase(Worksheets("overview").Cells(a, 15).Value) = "X" Then
C.Offset(0, 26) = Cells(2, 15)
C.Offset(0, 27) = C.Offset(0, 0) & Cells(2, 15)
C.Offset(0, 28) = Cells(2, 15)
C.Offset(0, 29) = C.Offset(0, 0) & Cells(2, 15)
Else
If UCase(Worksheets("overview").Cells(a, 16).Value) = "X" Then
C.Offset(0, 26) = Cells(2, 16)
C.Offset(0, 27) = C.Offset(0, 0) & Cells(2, 16)
C.Offset(0, 28) = Cells(2, 16)
C.Offset(0, 29) = C.Offset(0, 0) & Cells(2, 16)
Else
If UCase(Worksheets("overview").Cells(a, 17).Value) = "X" Then
C.Offset(0, 26) = Cells(2, 17)
C.Offset(0, 27) = C.Offset(0, 0) & Cells(2, 17)
C.Offset(0, 28) = Cells(2, 17)
C.Offset(0, 29) = C.Offset(0, 0) & Cells(2, 17)
Else
If UCase(Worksheets("overview").Cells(a, 18).Value) = "X" Then
C.Offset(0, 26) = Cells(2, 18)
C.Offset(0, 27) = C.Offset(0, 0) & Cells(2, 18)
C.Offset(0, 28) = Cells(2, 18)
C.Offset(0, 29) = C.Offset(0, 0) & Cells(2, 18)
End If
End If
End If
End If
End If
End If
End If
End If
Worksheets("Aliste").Cells(l, 1) = Worksheets("overview").Cells(a, 1) 'Kennzeichen
Worksheets("Aliste").Cells(l, 2) = Worksheets("overview").Cells(a, 3) ' Satznummer
Worksheets("Aliste").Cells(l, 3) = Worksheets("overview").Cells(a, 28) 'Lagerpaltz
Worksheets("Aliste").Cells(l, 4) = Worksheets("overview").Cells(a, 2) 'Vin
Worksheets("Aliste").Cells(l, 5) = Worksheets("overview").Cells(a, 27) 'Termin
Worksheets("Aliste").Cells(l, 6) = Worksheets("overview").Cells(a, 29) 'Service
Worksheets("Aliste").Cells(l, 7) = Worksheets("overview").Cells(a, 8) 'VL
Worksheets("Aliste").Cells(l, 8) = Worksheets("overview").Cells(a, 9) 'VR
Worksheets("Aliste").Cells(l, 9) = Worksheets("overview").Cells(a, 10) 'HL
Worksheets("Aliste").Cells(l, 10) = Worksheets("overview").Cells(a, 11) 'HR
Worksheets("Radmontage Formular").Cells(13, 7) = Worksheets("overview").Cells(a, 1) ' _
Kennzeichen
Worksheets("Radmontage Formular").Cells(13, 5) = Worksheets("overview").Cells(a, 2) 'Vin
Worksheets("Radmontage Formular").Cells(9, 5) = Worksheets("overview").Cells(a, 3) '  _
Satznummer
Worksheets("Radmontage Formular").Cells(11, 5) = "*" & Worksheets("overview").Cells(a, 3) &  _
"*" ' Satznummer code
Worksheets("Radmontage Formular").Cells(12, 5) = Worksheets("overview").Cells(a, 28) ' _
Lagerpaltz
Worksheets("Radmontage Formular").Cells(10, 5) = Worksheets("overview").Cells(a, 4) 'Menge
Worksheets("Radmontage Formular").Cells(14, 5) = Worksheets("overview").Cells(a, 27) ' _
Termin
Worksheets("Radmontage Formular").Cells(3, 1) = Worksheets("overview").Cells(a, 29) ' _
Service
Worksheets("Radmontage Formular").Cells(1, 9) = Worksheets("overview").Cells(a, 8) 'VL
Worksheets("Radmontage Formular").Cells(2, 9) = Worksheets("overview").Cells(a, 9) 'VR
Worksheets("Radmontage Formular").Cells(3, 9) = Worksheets("overview").Cells(a, 10) 'HL
Worksheets("Radmontage Formular").Cells(4, 9) = Worksheets("overview").Cells(a, 11) 'HR
Worksheets("Radmontage Formular").Cells(55, 1) = "*" & Worksheets("overview").Cells(a, 30) & _
"*" 'Service code
Worksheets("Radmontage Formular").Cells(14, 7) = Worksheets("overview").Cells(a, 26)  ' _
Termin
Worksheets("Radmontage Formular").Cells(53, 1) = Worksheets("overview").Cells(a, 6) ' _
Bemerkung
Worksheets("Radmontage Formular").Cells(9, 7) = Date 'Datum
Sheets("Radmontage Formular").PrintOut Copies:=1    ' druck auf a4 drucker (sd)
C.Interior.ColorIndex = 42
If UCase(Worksheets("overview").Cells(a, 12).Value) = "X" Then  ' pr?ft ob bedingung  _
erf?llt ist das Label gedruckt werden
Application.ActivePrinter = ld   ' umstellung auf Labeldrucker ld
Worksheets("Felgen Aufkleber").Cells(3, 1) = Worksheets("overview").Cells(a, 6) ' _
Bemerkung
Worksheets("Felgen Aufkleber").Cells(4, 2) = Worksheets("overview").Cells(a, 3) '  _
Satznummer
Worksheets("Felgen Aufkleber").Cells(6, 2) = Worksheets("overview").Cells(a, 28) ' _
Lagerpaltz
Worksheets("Felgen Aufkleber").Cells(5, 3) = ""
If Not IsEmpty(Worksheets("overview").Cells(a, 27)) Then Worksheets("Felgen Aufkleber"). _
Cells(5, 3) = Worksheets("overview").Cells(a, 27) - 5 'Termin
If UCase(Worksheets("overview").Cells(a, 8).Value) = "X" Then
Worksheets("Felgen Aufkleber").Cells(5, 2) = "VL"
Sheets("Felgen Aufkleber").PrintOut Copies:=4  ' Druck  _
Label auf ld
End If
If UCase(Worksheets("overview").Cells(a, 9).Value) = "X" Then
Worksheets("Felgen Aufkleber").Cells(5, 2) = "VR"
Sheets("Felgen Aufkleber").PrintOut Copies:=4  ' Druck  _
Label auf ld
End If
If UCase(Worksheets("overview").Cells(a, 10).Value) = "X" Then
Worksheets("Felgen Aufkleber").Cells(5, 2) = "HL"
Sheets("Felgen Aufkleber").PrintOut Copies:=4  ' Druck  _
Label auf ld
End If
If UCase(Worksheets("overview").Cells(a, 11).Value) = "X" Then
Worksheets("Felgen Aufkleber").Cells(5, 2) = "HR"  ' Druck  _
Label auf ld
Sheets("Felgen Aufkleber").PrintOut Copies:=4
End If
Application.ActivePrinter = sd ' Umstellung wieder auf  _
Standartdrucker A4 ( sd ) da erster Druck vom n?chsten Auftrag ( Montageformular) auf A4 sein muss
C.Interior.ColorIndex = 6
End If
End If
l = l + 1
Next ' sprung zum n?chsten select
Worksheets("Aliste").PrintOut Copies:=1
Worksheets("Aliste").Visible = False
Worksheets("Radmontage Formular").Visible = False
Worksheets("Felgen Aufkleber").Visible = False
Application.ScreenUpdating = True
End Sub

Anzeige
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
08.02.2020 23:26:26
Chris
ich lasse es mal noch offen, vielleicht hat jemand noch ne Lösung oder ein Ansatz.
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
09.02.2020 10:35:08
Werner
Hallo,
in erster Linie wäre es mal an dir gewesen, den Code in einer lesbaren Form zu posten, so kann den kein Mensch lesen oder analysieren.
Da du das nicht gemacht hast, habe ich ihn mal eingekürzt und in eine lesbare Form gebracht - so wie ich den Ablauf verstanden habe.
Teste mal, ob das so passt -natürlich mit einer Kopie deiner Datei, weil testen konnte ich ihn nicht.
Option Explicit
Sub Drucken_NEU()
Dim a As Long, l As Long, i As Long
Dim z As Long, su As Long, C As Range
Dim sd As String, ld As String
Application.ScreenUpdating = False
Worksheets("Aliste").Visible = True
Worksheets("Radmontage Formular").Visible = True
Worksheets("Felgen Aufkleber").Visible = True
Sheets("Aliste").Range("A2:J1000").ClearContents
With Worksheets("overview")
If sd = "" Then
MsgBox "Bitte A4 Standarddrucker wählen"
Application.Dialogs(xlDialogPrinterSetup).Show
sd = Application.ActivePrinter
End If
If ld = "" Then
MsgBox "Bitte Labeldrucker auswählen"
Application.Dialogs(xlDialogPrinterSetup).Show
ld = Application.ActivePrinter
End If
Application.ActivePrinter = sd
l = 2
For Each C In Selection
su = 0
a = C.Row
For i = 12 To 18
If UCase(.Cells(a, i)) = "X" Then
For z = 8 To 11
If UCase(.Cells(a, z)) = "X" Then su = su + 1
Next z
Exit For
End If
Next i
.Cells(a, 4) = su
If IsEmpty(C.Offset(0, 26).Value) Or IsEmpty(C.Offset(0, 28).Value) Then
If UCase(.Cells(a, 12).Value) = "X" Then
C.Offset(0, 26) = Cells(2, 12)
C.Offset(0, 27) = C & .Cells(2, 12)
If UCase(.Cells(a, 19).Value) = "X" Then
C.Offset(0, 28) = .Cells(2, 19)
C.Offset(0, 29) = C & .Cells(2, 19)
ElseIf UCase(.Cells(a, 20).Value) = "X" Then
C.Offset(0, 28) = .Cells(2, 20)
C.Offset(0, 29) = C & .Cells(2, 20)
ElseIf UCase(.Cells(a, 21).Value) = "X" Then
C.Offset(0, 28) = .Cells(2, 21)
C.Offset(0, 29) = C & .Cells(2, 21)
ElseIf UCase(.Cells(a, 22).Value) = "X" Then
C.Offset(0, 28) = .Cells(2, 22)
C.Offset(0, 29) = C & .Cells(2, 22)
Else
End If
Else
End If
Else
For i = 13 To 18
If UCase(.Cells(a, i).Value) = "X" Then
C.Offset(0, 26) = .Cells(2, i)
C.Offset(0, 27) = C & .Cells(2, i)
C.Offset(0, 28) = .Cells(2, i)
C.Offset(0, 29) = C & .Cells(2, i)
End If
Next i
End If
Worksheets("Aliste").Cells(l, 1) = .Cells(a, 1)
Worksheets("Aliste").Cells(l, 2) = .Cells(a, 3)
Worksheets("Aliste").Cells(l, 3) = .Cells(a, 28)
Worksheets("Aliste").Cells(l, 4) = .Cells(a, 2)
Worksheets("Aliste").Cells(l, 5) = .Cells(a, 27)
Worksheets("Aliste").Cells(l, 6) = .Cells(a, 29)
Worksheets("Aliste").Cells(l, 7) = .Cells(a, 8)
Worksheets("Aliste").Cells(l, 8) = .Cells(a, 9)
Worksheets("Aliste").Cells(l, 9) = .Cells(a, 10)
Worksheets("Aliste").Cells(l, 10) = .Cells(a, 11)
Worksheets("Radmontage Formular").Cells(13, 7) = .Cells(a, 1)
Worksheets("Radmontage Formular").Cells(13, 5) = .Cells(a, 2)
Worksheets("Radmontage Formular").Cells(9, 5) = .Cells(a, 3)
Worksheets("Radmontage Formular").Cells(11, 5) = "*" & .Cells(a, 3) & "*"
Worksheets("Radmontage Formular").Cells(12, 5) = .Cells(a, 28)
Worksheets("Radmontage Formular").Cells(10, 5) = .Cells(a, 4)
Worksheets("Radmontage Formular").Cells(14, 5) = .Cells(a, 27)
Worksheets("Radmontage Formular").Cells(3, 1) = .Cells(a, 29)
Worksheets("Radmontage Formular").Cells(1, 9) = .Cells(a, 8)
Worksheets("Radmontage Formular").Cells(2, 9) = .Cells(a, 9)
Worksheets("Radmontage Formular").Cells(3, 9) = .Cells(a, 10)
Worksheets("Radmontage Formular").Cells(4, 9) = .Cells(a, 11)
Worksheets("Radmontage Formular").Cells(55, 1) = "*" & .Cells(a, 30) & "*"
Worksheets("Radmontage Formular").Cells(14, 7) = .Cells(a, 26)
Worksheets("Radmontage Formular").Cells(53, 1) = .Cells(a, 6)
Worksheets("Radmontage Formular").Cells(9, 7) = Date
Sheets("Radmontage Formular").PrintOut Copies:=1
C.Interior.ColorIndex = 42
If UCase(.Cells(a, 12).Value) = "X" Then
Application.ActivePrinter = ld
Worksheets("Felgen Aufkleber").Cells(3, 1) = .Cells(a, 6)
Worksheets("Felgen Aufkleber").Cells(4, 2) = .Cells(a, 3)
Worksheets("Felgen Aufkleber").Cells(6, 2) = .Cells(a, 28)
Worksheets("Felgen Aufkleber").Cells(5, 3) = ""
If Not IsEmpty(.Cells(a, 27)) Then Worksheets("Felgen Aufkleber").Cells(5, 3) _
= .Cells(a, 27) - 5
If UCase(.Cells(a, 8).Value) = "X" Then
Worksheets("Felgen Aufkleber").Cells(5, 2) = "VL"
Sheets("Felgen Aufkleber").PrintOut Copies:=4
ElseIf UCase(.Cells(a, 9).Value) = "X" Then
Worksheets("Felgen Aufkleber").Cells(5, 2) = "VR"
Sheets("Felgen Aufkleber").PrintOut Copies:=4
ElseIf UCase(Worksheets("overview").Cells(a, 10).Value) = "X" Then
Worksheets("Felgen Aufkleber").Cells(5, 2) = "HL"
Sheets("Felgen Aufkleber").PrintOut Copies:=4
ElseIf UCase(Worksheets("overview").Cells(a, 11).Value) = "X" Then
Worksheets("Felgen Aufkleber").Cells(5, 2) = "HR"
Sheets("Felgen Aufkleber").PrintOut Copies:=4
End If
End If
Application.ActivePrinter = sd
C.Interior.ColorIndex = 6
l = l + 1
Next C
End With
Worksheets("Aliste").PrintOut Copies:=1
Worksheets("Aliste").Visible = False
Worksheets("Radmontage Formular").Visible = False
Worksheets("Felgen Aufkleber").Visible = False
End Sub
Gruß Werner
Anzeige
AW: ActivePrinter schatltet drucker nicht um und bricht ab. im Debugger mit F8 läuft das Makro an dem punkt weiter.
12.02.2020 22:36:17
Chris
Hallo Werner, 

es hat leider ein wenig gedauert das ich es testen konnte.
Ich danke Dir erstmal für deine Mühe denn Code umzuschreiben, bin noch nicht so lange in VBA tä _
tig und Google mir viel zusammen.
das Problem besteht aber leider weiterhin.
also dein Code läuft aber nicht in dem einen Standort.
er bleibt genau wieder an der Stelle 


Application.ActivePrinter = sd

 stehen,  bringt die gleiche Fehlermeldung.

Kann es sein das das ganze was mit dem Netzwerk-Einstellungen, das da was blockt zu tun hat oder dem Drucker selber auch wenn er andere normale Dokumente druckt. Ich denke da an druckspooler oder so.

Mir ist halt echt nicht plausible wieso die der Code auf 6 anderen PC´s die in 3 anderen Netzwerken in anderen Standorten stehen läuft. und genau dort in dem Standort auf 2 PC die es dort im Netzwerk gibt Probleme macht. 

LG Chris
Anzeige

Links zu Excel-Dialogen

Label

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige