Sub Seite_speichern()
Dim Pfad As String, Dateiname As String, Ext As String
Ext = ".pdf"
Pfad = "C:\Users\FAMILY\Desktop\test\"
If Dir(Pfad, vbDirectory) = "" Then
MsgBox "Pfad '" & Pfad & "' existiert nicht"
Exit Sub
End If
Dateiname = Range("R5") & Format(Date, "_DD_MM_YYYY")
Dateiname1 = Dateiname & "_(1)"
If MsgBox("Soll die Datei vom " & [R5] & " gespeichert werden?", vbYesNo + vbQuestion, "Achtung") = vbYes Then
Do Until Dir(Pfad & Dateiname & Ext) = ""
Dateiname = InputBox("Datei bitte umbenennen mit Endung (1), (2), (3),......", "Die Datei existiert bereits. Bitte umbenenen ", Dateiname1)
If Dateiname = "" Then Exit Sub
Loop
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Pfad & Dateiname & Ext, _
Quality:=xlQualityStandard, IncludeDocProperties:= _
True, IgnorePrintAreas:=False, From:=1, To:=3, OpenAfterPublish:=True
End If
End Sub