AW: Ausw
12.10.2018 09:13:43
UweD
Hallo
Ich hänge ein Printscreen der Druckvorschau an
die Druckvorschau löst das Event noch nicht aus.
du kannst zum Testen den PDF-creator als Standarddrucker einstellen und dann direkt auf drucken gehen.
Evtl. hast du aber durch einen Fehler die Events NICHT WIEDER eingeschaltet.
Lass das einmal laufen
Sub onon()
Application.EnableEvents = True
End Sub
Ich hab das makro nochmal ein wenig überarbeitet
Option Explicit
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim Anzahl As Variant, Z2 As Integer
Dim TB1, TB2
Set TB1 = ActiveWorkbook.ActiveSheet
On Error GoTo Fehler
Cancel = True
Anzahl = InputBox("Anzahl der zu druckenden Etiketten", "Drucken", 2)
If Not IsNumeric(Anzahl) Then
MsgBox "Falsche Eingabe"
Exit Sub
End If
If Anzahl < 1 Or Anzahl > 10 Then
MsgBox "Mengenfehler"
Exit Sub
End If
With Application
.ScreenUpdating = False 'Flackern verhindern
.EnableEvents = False 'Druckschleife verhindern
.DisplayAlerts = False 'keine Rückfragen
End With
Z2 = WorksheetFunction.RoundUp(Anzahl / 2, 0) * 10 'bis Zeile
If Anzahl Mod 2 = 1 Then 'ungerade
'rechten Bereich merken und temporär löschen
Sheets.Add After:=ActiveSheet
Set TB2 = ActiveSheet
TB1.Cells(Z2 - 10 + 1, 6).Resize(10, 4).Cut TB2.Cells(1, 1).Resize(10, 4)
End If
'Druckbereich setzen
TB1.PageSetup.PrintArea = "$A$1:$I$" & Z2
'Ausdrucken
TB1.PrintOut , IgnorePrintAreas:=False
If Anzahl Mod 2 = 1 Then 'ungerade
'zurücklesen
TB2.Cells(1, 1).Resize(10, 4).Cut TB1.Cells(Z2 - 10 + 1, 6).Resize(10, 4)
TB2.Delete
End If
'Druckbereich zurücksetzen
TB1.PageSetup.PrintArea = "$A:$I"
'*** Fehlerbehandlung
Err.Clear
Fehler:
'Rücksetzen
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
If Err.Number <> 0 Then MsgBox "Fehler: " & _
Err.Number & vbLf & Err.Description: Err.Clear
End Sub
klappt bestens
5 St
6 St
9 St
LG UweD
