1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
| Private Sub Btn_99_Druckausgabe_Speichern_Click()
Dim pfad
Dim FileSaveName 'Pfad und Dateiname der zu sichernden Datei
'Datum aktualisieren
Range("Z_Datum") = Date
'Date$ liefert MM-TT-YYY. Die Bindestriche müssen raus
datum = Left(Date$, 2) & Mid(Date$, 4, 2) & Mid(Date$, 7, 4)
empfaenger = Range("Z_Titelblatt_Kunde")
pfad = ActiveWorkbook.Path
FileSaveName = Application.GetSaveAsFilename _
(InitialFileName:=pfad & "\Checkliste_" & empfaenger & "_" & datum, _
FileFilter:="EXCEL-Tabelle (*.xls), *.xls ,pdf datei (*.pdf),*.pdf")
If FileSaveName <> False Then
Select Case LCase$(Right$(FileSaveName, 3))
Case "xls"
ActiveSheet.SaveAs Filename:=FileSaveName
Case "pdf"
'deine Druckroutine für PDF
Application.ActivePrinter = "Adobe Pdf auf Ne01:"
ActiveWindow.PrintOut Copies:=1, Collate:=True
End Select
End If
On Error Resume Next 'Fehlerausgang, Weiter mit Löschen, wenn EMail abgelehnt wurde
End Sub |
Partager