Hallo zusammen,
ich möchte gerne folgenden Code umgestalten, das Pfad z.B. bis zum Oberordner "C:\Protokolle" vorgegeben ist.
Hier soll der Nutzer dann den Entsprechenden Ordner auswählen können.
Mein bisheriger Code erfordert viele Klicks bis man am Ziel ist.
Vielleicht kann mir jemand helfen.
Sub fg_pdf()
Dim datum As Variant
datumquell = Tabelle2.Cells(1, 2)
datum = Format(datumquell, "dd.mm.yyyy")
If MsgBox("Als PDF speichern und Einträge löschen?", vbYesNo) = vbYes Then
Tabelle2.Select
Dim pdfName As String
Dim pdfOpenAfterPublish As Boolean
Dim olApp As Object
Dim olOldBody As String
Dim varFilename As Variant
pdfName = "Protokollbericht vom " & datum
pdfOpenAfterPublish = True
Rem Pfad und Name der PDF-Datei
varFilename = Application.GetSaveAsFilename( _
InitialFileName:=pdfName & ".pdf", _
filefilter:="PDF (*.pdf), *.pdf", _
Title:="als PDF speichern")
If varFilename <> False Then
Rem PDF-Datei erstellen. Funktioniert nur in Excel 2007 oder höher, nicht in Excel 2003 oder älter
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfName, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=IIf(pdfOpenAfterPublish, True, False)
Rem Boolean-Variable "pdfOpenAfterPublish" zurücksetzen
pdfOpenAfterPublish = False
End If
On Error GoTo 0
Application.ScreenUpdating = False
ActiveSheet.Unprotect
Range("C8:I11,K8:Q11,B18:Q26,B30:P32,B37:P41").Activate
Selection.ClearContents
Range("A1").Select
Tabelle2.Select
Range("C8:I11,K8:Q11").ClearFormats
Range("C8:I8,C9:I9,C10:I10,C11:I11,K8:Q8,K9:Q9,K10:Q10,K11:Q11").MergeCells = True
Range("C8:I8,C9:I9,C10:I10,C11:I11,K8:Q8,K9:Q9,K10:Q10,K11:Q11").Activate
Selection.Locked = False
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowInsertingHyperlinks:=True, AllowSorting:=True, AllowFiltering:=True
Range("C8").Select
Application.ScreenUpdating = True
Else
If MsgBox("Nur als PDF speichern?", vbYesNo) = vbYes Then
Tabelle2.Select
pdfName = "Protokollbericht vom " & datum
pdfOpenAfterPublish = True
Rem Pfad und Name der PDF-Datei
varFilename = Application.GetSaveAsFilename( _
InitialFileName:=pdfName & ".pdf", _
filefilter:="PDF (*.pdf), *.pdf", _
Title:="als PDF speichern")
If varFilename <> False Then
Rem PDF-Datei erstellen. Funktioniert nur in Excel 2007 oder höher, nicht in Excel 2003 oder älter
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfName, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=IIf(pdfOpenAfterPublish, True, False)
Rem Boolean-Variable "pdfOpenAfterPublish" zurücksetzen
pdfOpenAfterPublish = False
End If
On Error GoTo 0
Tabelle2.Select
Else
MsgBox "Vorgang abgebrochen"
End If
End If
Tabelle2.Select
End Sub