|
Hallo,
ich habe es geschafft, dass die Datei nicht überschrieben wird und eine Abfrage kommt, wo man den Namen manuell ändern kann. Ich möchte aber, dass die Datei automatisch umbenannt wird.
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)"
' Seite_speichern Makro
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
' speichert Tabelle unter Pfad und vorgegebenen Namen als pdf
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Pfad & Dateiname & Ext, _
Quality:=xlQualityStandard, IncludeDocProperties:= _
True, IgnorePrintAreas:=False, From:=1, To:=3, OpenAfterPublish:=True
End If
End Sub
LG
Krzysztof
|