Ich habe den unten stehenden befehl in gebrauch, da bin ich seit einiger zeit am versuchen es hin zu bekommen, dass keine Datein überschrieben werden
sondern die Datein aufgezählt werden, wenn der name bereits Vorhanden ist.
z.b.:
1. Datei ist Test
2. Datei soll dann Test_1
3. Datei soll dann Test_2 sein und so weiter
Sub Ppdf()
'
' PDF Makro
'
'
Call MsgBox("Bitte den exakten Ordner wählen in dem Gespeichert werden soll.", _
vbExclamation)
Const C_ROOT = "C:\Users\tablette\Desktop\Ergebnisse\"
On Error GoTo ErrHandler
Dim wks As Excel.Worksheet
Dim strFilename As String
Dim vntVisiblePrev As Variant
Set wks = Worksheets("Auswertung PDF")
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Speicherort für PDF-Datei auswählen ..."
.InitialView = msoFileDialogViewList
.InitialFileName = C_ROOT
Call .Show
If .SelectedItems.Count > 0 Then
If 0 <> StrComp(Left$(.SelectedItems(1), Len(C_ROOT)), C_ROOT, vbTextCompare) Then
Call MsgBox("Keinen Ordner gewählt. Bitte den Ordner wählen in dem Gespeichert werden soll. Bitte nochmal auf PDF-Drucken drücken.", _
vbExclamation)
Exit Sub
End If
strFilename = .SelectedItems(1) & "\"
If Trim$(wks.Range("J4")) = "" Then
Call MsgBox("Visum Fehlt!", _
vbExclamation)
Exit Sub
End If
If Trim$(wks.Range("B5")) = "" Then
Call MsgBox("Charge Fehlt!", _
vbExclamation)
Exit Sub
End If
strFilename = strFilename & Trim$(wks.Range("B5").Text) & ".pdf"
vntVisiblePrev = wks.Visible
wks.Visible = xlSheetVisible
Call wks.ExportAsFixedFormat( _
Type:=xlTypePDF, _
Filename:=strFilename, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True)
wks.Visible = vntVisiblePrev
End If
End With
Exit Sub
ErrHandler:
Call MsgBox(Err.Description, vbCritical, "Fehler " & Err.Number)
End Sub
|