.pdf per VB in einen Unterordner abspeichern
28.11.2018 09:24:11
Kalle
Ich grüble schon seit Tagen über dieses Problem. Meine VB-Kenntnisse sind eher bescheiden. Bin deshalb auch ganz stolz darüber, dass der untenstehende Code funktioniert. Bis auf einen kleinen Wermutstropfen. Die pdf's werden nicht dort gespeichert, wo ich sie erwarte, sondern im Verzeichnis eine Ebene zu früh.Also vor dem Ornder wo die .xls liegt. Wo liegt der (mein) Fehler?
Schon mal ganz herzlichen Dank an alle Helfer.
DateiPfad = Application.ActiveWorkbook.Path
Dim DateiName As String
Select Case MsgBox("Wollen Sie jetzt das Protokoll als .pdf erstellen und speichern?", _
vbYesNo Or vbQuestion Or vbDefaultButton1, "Hinweis")
Case vbYes
Sheets("Protokoll").Range("C8:M10005").ClearContents 'löscht altes Protokoll
Sheets("Neue Eingaben").Range("B3:M9999").Copy
Sheets("Protokoll").Range("C8").PasteSpecial Paste:=xlPasteValues, Operation:= _
xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Protokoll").Select 'pdf erzeugen und speichern
If Sheets("Protokoll").Range("A2") = 0 Then
MsgBox ("Bitte nur je eine Abteilung und je ein Datum filtern")
Sheets("Neue Eingaben").Protect DrawingObjects:=True, Contents:=True, Scenarios: _
=True _
, AllowFiltering:=True
ElseIf Sheets("Protokoll").Range("A2") = 1 Then
DateiName = DateiPfad & Range("d6") & " " & Range("c6") & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
DateiName, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas _
:=False, OpenAfterPublish:=True
Sheets("Neue Eingaben").Select
End If
Case vbNo
Exit Sub
End Select
End Sub
Anzeige