Huhu,
ich hab den Code jetzt geschafft weitesgehen dos hinzubekommen wie ich er grundsätzlich funktionieren soll, ein paar Sachen jedoch stören mich noch.
- Sobald die XLSX überschrieben werden soll und ich das verneine, bekomme ich einen fehler, der soll nicht sein.
- Bei jedem Klick auf das Makro werde ich in de gespeicherte XLSX geworfen, würde aber gerne in der ursprünglichen bleiben.
Option Explicit
Public Sub Save()
ActiveWorkbook.SaveAs Filename:= _
"K:\Pricing\XLSX" & "NPL" & Space(1) & Range("Daten!B4") & Space(1) & Range("Daten!B2") & Space(1) & Range("Daten!B3") & Space(1) & Format(Date, "YYYY-MM-DD") _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Dim i As Integer, PDFindex As Integer
Dim strFilePDF As String
With Application.FileDialog(msoFileDialogSaveAs)
PDFindex = 0
For i = 1 To .Filters.Count
If InStr(VBA.UCase(.Filters(i).Description), "PDF") > 0 Then PDFindex = i
Next
.Title = "PDF"
'Speicherort-Abfrage und erzeugung des Dateinamens aus Feldern der Excel-Datei.
.InitialFileName = "K:\Pricing\PDF" & "NPL" & Space(1) & Range("Daten!B4") & Space(1) & Range("Daten!B2") & Space(1) & Range("Daten!B3") & Space(1) & Format(Date, "YYYY-MM-DD")
.FilterIndex = PDFindex
If .Show Then
On Error GoTo Fehler
'Hier wird eine PDF aus einem bestimmten Bereich eines bestimmten Tabellenblatt erzeugt.
Sheets("Ausgabe").Range("A1:E86").ExportAsFixedFormat Type:=xlTypePDF, Filename:=.SelectedItems(1), _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case -2147018887
If MsgBox(strFilePDF & "Datei noch geöffnet, bitte schließen.", _
vbInformation + vbOKCancel, _
"Fehler") = vbOK Then
Resume
End If
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
End If
End With
End Sub
Dann habe ich außerdem noch ein Makro zur versendung einer Mail geschrieben, da stört mich folgendes, aber ich weiß nicht wie man das anders machen soll.
- Bei jeder Mail die ich versenden will über das Makro wird eine PDF im Ordner erstellt, kann man das auch bewerkstelligen indem man die Datei nur als Anhang hat ?
Sub PDFundSenden()
Const DateiPfad = "K:\Mail\"
Dim DateiName As String
DateiName = DateiPfad & "NPL" & Space(1) & Range("Daten!B4") & Space(1) & Range("Daten!B2") & Space(1) & Range("Daten!B3") & Space(1) & Format(Date, "YYYY-MM-DD") & ".pdf"
Sheets("Ausgabe").Range("A1:E86").ExportAsFixedFormat Type:=xlTypePDF, Filename:=DateiName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Dim Outlook As Object
Dim OutlookmailItem As Object
Dim myAttachments As Object
Set OutlookApp = CreateObject("outlook.application")
Set OutlookmailItem = OutlookApp.CreateItem(0)
Set myAttachments = OutlookmailItem.Attachments
With OutlookmailItem
.to = ""
.Subject = "Nettopreisliste vom " & Format(Date, "DD.MM.YYYY")
.body = "Sehr geehrte Damen und Herren," _
& vbLf & vbLf & "Anbei finden Sie die PDF mit Ihrer Preisliste, bitte entnehmen Sie dieser sorgfältig alle Informationen." _
& vbLf & vbLf & vbLf & "" _
& vbLf & vbLf & "Mit freundlichen Grüßen." & vbLf & strMaterial
myAttachments.Add DateiName
.display
End With
Set OutlookApp = Nothing
Set OutlookmailItem = Nothing
End Sub
Wäre toll wenn mir jemande helfen könnte.
Lieb Gruß
J4it
|