Laufzeitfehler 6 beim Drucken über VBA
17.06.2021 16:11:15
Quaelgaeist
Bei Aktivierung werkelt Excel 2016 rund 2 Minuten und 20 Sekunden herum
und dann folgt der Laufzeitfehler 6: Überlauf.
Laut den "ausführenden" Mitarbeitern hat das Makro bis jetzt funktioniert.
Ich hab keine passenden Hinweise über g00gle gefunden, und mir gedacht ich frag Spezialistinnen und Spezialisten.
Das Excel Sheet ist mit Daten aus unserem ERP gefüllt, von daher möchte ich das nicht so direkt hochladen.
Hoffe es kann mir trotzdem jemand helfen.
Schöne Grüße und Danke im Voraus
Sub Etikett_Drucken()
Application.ScreenUpdating = False 'Damit Bildschirm erst nach Berechnung aller Zellen aktualisiert wird, verhindert Flimmern
Dim Anzahl_Kopien As Integer
Dim StdDrucker As String
Dim Anschluss As Integer
On Error GoTo Fehler
'Anzahl_Kopien = Worksheets("Etikett").Cells(7, 6).Value
Anzahl_Kopien = ActiveSheet.Cells(7, 11).Value
Anschluss = 0
StdDrucker = Application.ActivePrinter 'Standarddrucker merken
'Drucker auswählen
Drucker_setzen:
Anschluss = Anschluss + 1 'Zähler für Anschluss, da dieser auf jedem PC anders ist
'Druckerauswahl 50/101/152mm hat keinen Einfluss auf Etikettengröße -> siehe .PaperSize weiter unten
Application.ActivePrinter = "\\SERVERPFAD\DRUCKERFREIGABENAME" & Format(Anschluss, "00") & ":"
'Seite einrichten
With Worksheets("Etikett").PageSetup
.PrintArea = "$A$1:$E$11"
.PaperSize = 257 '257 = 50mm; 258 = 101mm; 259 = 152mm
.Orientation = xlPortrait
.LeftMargin = Application.CentimetersToPoints(0)
.RightMargin = Application.CentimetersToPoints(0)
.TopMargin = Application.CentimetersToPoints(0)
.BottomMargin = Application.CentimetersToPoints(0)
.FooterMargin = Application.CentimetersToPoints(0)
.HeaderMargin = Application.CentimetersToPoints(0)
.Zoom = 100
.CenterHorizontally = False
.CenterVertically = True
End With
'Drucken mit Etikettendrucker
Worksheets("Etikett").PrintOut Copies:=Anzahl_Kopien
Application.ActivePrinter = StdDrucker 'Standarddrucker wiederherstellen
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case 9 'Laufzeitfehler 9 ignorieren
Case 1004 'Index-Fehler in Liste
Resume Drucker_setzen
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
Application.ScreenUpdating = True 'Damit Bildschirm erst nach Berechnung aller Zellen aktualisiert wird, verhindert Flimmern
End Sub