Makro erstellen,speichern, drucken
01.03.2019 16:32:47
Tim
ich habe mir ein Makro zusammengestellt, welches mir den Inhalt aus einer Userform, in eine neue Tabelle einfügen soll, eine fortlaufende Nummer generiert, die Tabelle unter einem bestimmten Pfad abspeichert und zum Schluss ausdrucken soll. das Ganze ist eine Art Materialbestellung.
Das Makro funktioniert ohne die Druckoption perfekt.
Nehme ich die Möglichkeit der Druckoption hinzu, druckt er nicht die erstellte Tabelle sondern die Tabelle auf der sich die Userform befindet.
Wer kann mir dabei helfen, dass er nur die neuerstellte Tabelle druckt, wenn bei der Druckerauswahl der richtige Drucker ausgewählt und nicht auf abbrechen gedrückt wurde?
Private Sub CommandButton1_Click()
'Druckt den Auftrag aus
Dim strPrinterName As String
Dim varRueckgabe As Variant
strPrinterName = Application.ActivePrinter
varRueckgabe = Application.Dialogs(xlDialogPrinterSetup).Show
If varRueckgabe = "Falsch" Then
ActiveWorkbook.Close savechanges:=False
Exit Sub
Else
'*********************************************************************************************** _
Dim wkb As Workbook 'Auftragsnummer generieren
Dim ws As Worksheet
Dim lz As Long
Dim Jahr As String
Dim Tag As String
Set wkb = ThisWorkbook
Set ws = wkb.Worksheets("Auftragsnummer")
lz = ws.Cells(Rows.Count, 1).End(xlUp).Row
Jahr = Year(Date)
Tag = Format(Date, "dd.mm")
With ws
If .Range("B" & lz) Jahr Then
.Range("A" & lz + 1) = "AU"
.Range("B" & lz + 1) = Jahr
.Range("C" & lz + 1) = 1
.Range("D" & lz + 1) = .Range("A" & lz + 1) & .Range("B" & lz + 1) & "-" & .Range(" _
C" & lz + 1) 'verkettet die neue Auftragsnummer bei Jahreswechsel
UserForm1.Label99 = .Range("A" & lz + 1) & .Range("B" & lz + 1) & "-" & .Range("C" _
& lz + 1)
Else
.Range("C" & lz) = .Range("C" & lz) + 1
.Range("D" & lz) = .Range("A" & lz) & .Range("B" & lz) & "-" & .Range("C" & lz) ' _
verkettet die drei Spalten zu einer Auftagsnummer
UserForm1.Label99 = .Range("A" & lz) & .Range("B" & lz) & "-" & .Range("C" & lz) ' _
schreibt in Userform die Auftragsnummer zurück
End If
End With
'*********************************************************************************************** _
Dim i As Long
Dim j As Long
Application.ScreenUpdating = False ' sorgt dafür, dass der Fokus auf der Eingabemaske bleibt _
und das erstellen + speichern im Hintergrund passiert
Workbooks.Add
With UserForm1.ListBox1
For i = 0 To .ListCount - 1
For j = 0 To .ColumnCount - 1
Cells(i + 22, j + 1) = .List(i, j)
Cells(i + 22, j + 1).HorizontalAlignment = xlCenter 'zentriert
Cells(20, j + 1).Borders(xlEdgeBottom).LineStyle = xlContinuous ' setzt unterhalb _
der Überschrift einen Rahmen
Next j
Next i
End With
'*********************************************************************************************** _
Dim lfdNr 'nummeriert die übertragenen Artikel in Positionsnummern durch
lfdNr = 1
For i = 22 To Cells(Rows.Count, 2).End(xlUp).Row
If Cells(i, 2).Value > 0 Then
Cells(i, 1).Value = lfdNr
lfdNr = lfdNr + 1
Cells(i, 1).HorizontalAlignment = xlCenter 'zentriert
Cells(i, 5) = Clear ' löscht den Preis, der nur für die Eventmanager als Kalkulation dient
End If
Next
Dim NeuerName As String, Speicherpfad As String 'speichert unter
Speicherpfad = "C:\Test\Aufträge\"
NeuerName = "Auftrag_" & UserForm1.Label99 ' + Lieferdatum
ActiveWorkbook.SaveAs Filename:=Speicherpfad & NeuerName & "_" & "ea" & "_" & Date & "_" & "Ld" _
& "_" & UserForm1.Label101 & ".xlsx" 'speichert den Auftrag unter Auftragsnummer, erstellt am "ea" und Lieferdatum "Ld" aus Label101
ActiveWorkbook.Close
MsgBox "dein Auftrag wurde erfolgreich übermittelt!"
'Hier den PrintOut befehl
ActiveWorkbook.PrintOut Copies:=2, Collate:=True
Application.ActivePrinter = strPrinterName
'ActiveWorkbook.Close savechanges:=False
End If
'drucken, speichern und schließen
End Sub