Hallo,

ich lass über der unten stehende Code eine Seite ausdrucken:
Nach jedes Druckbefehl wird die Seiten aufbau immer langsamer und nach dem vierten oder fünften Druckbefehl hängt Excel,
wo ich die Situation über Task Manager beende!

Was ist da falsch?

Danke
Sub drucken()
Dim btZahl As String
Dim show As String
Dim p_anz, k_anz As String

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
.AskToUpdateLinks = False
End With
On Error GoTo hata

btZahl = 5
show = Application.Dialogs(xlDialogPrinterSetup).show
If show = False Then
GoTo iptal
End If
With ThisWorkbook.Sheets("Etiketler").PageSetup
On Error Resume Next
.PrintArea = "$BV$99:$CD$162"
.Orientation = xlLandscape
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.PrintQuality = 203
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.Zoom = 39
On Error GoTo hata
End With
ThisWorkbook.Sheets("Etiketler").PrintOut Copies:=btZahl, Collate:=False

iptal:
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
.AskToUpdateLinks = True
End With
Exit Sub
hata:
MsgBox "Dokument wurde zwecks ein Fehlende Parameter nicht bedruckt!", , "Yükleme Plani 2016"
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
.AskToUpdateLinks = True
End With
End Sub