Hi zusammen,
habs ausprobiert, funktionierte aber nicht auf anhieb, hab's aber zum laufen gebracht, die Zeile: "Dim strFilePDF As String" unterhalb von "On Error GoTo Fehler" hat zu einem Fehler geführt, dass löschen dieser Zeile hat das behoben, vermutlich da die Anweisung zu begin schon vorhanden ist und es sich somit gebissen hat, weil es doppel vorhanden war.
Desweiteren habe ich die Message für die ausgebende Fehlermeldung etwas abgespreckt, dass war mir zuviel BlaBla um den heißen Brei.
Hier mein final Code, funktioniert so einwandfrei!
Option Explicit
Public Sub Save_As_PDF()
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 = "C:\Users\User\Documents" & "Musterbezeichnung" & Space(1) & Range("Eingabe!A1") & Space(1) & Range("Eingabe!A2") & Space(1) & Range("Eingabe!A3") & 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:G55").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
Vielen lieben Dank Torsten! Ich denke, ich bin jetzt wunschlos glücklich!
Beste Grüße
J4it
|