Blatt als PDF speichern (Excel 2007)
Gerhard
in einem gelegentlich langsamen Intranet muss ein Excel-Blatt von verschiedenen Netzwerk-PC aus mit diesem Code in einen vorhandenen oder neu erzeugten Ordner gespeichert werden.
Immer wieder kommt es vor, dass nicht in den mit If Dir(spath, 16) = "" Then MkDir (spath) erzeugten spath-Ordner gespeichert wird. Der neue Ordner wird zwar erzeugt und auch die PDF-Datei wird geöffnet. Aber die PDF-Datei wird in den anderen Ordner "Eigene Dateien" abgespeichert.
Bei manchen Speichervorgängen geschieht alles korrekt, aber immer wieder wird im falschen Zielordner gespeichert. Woran kann das liegen?
Vielen Dank für die gern erwartete Tipps! (schaue erst heute nach ca. 18:00 Uhr nach...)
Gruß
Gerhard E.
Sub Blatt_als_PDF_Speichern()
Dim wkbWorkbook As Workbook
Dim Wks As Worksheet
Dim azubi As String
Dim azubiname As String
Dim beurt As String
Dim was As String
Dim wer As String
Dim wann As String
Dim path As String
Dim person As String
Dim mailan As String
Dim speichername As String
Dim Blattname As String
Dim spath As String
Application.ScreenUpdating = False
azubiname = Sheets("listen").Range("azubi").Value
person = Sheets("listen").Range("absender").Value 'Absender
was = Sheets("start").Range("kürzel").Value 'Bereich
spath = Sheets("listen").Range("speicherordner").Value 'Speicherort
wann = Format(Now(), "YY-MM-DD_hhmm") 'Speicherzeit
wer = Environ("UserName")
Blattname = azubiname & "-" & was 'Blattname
ActiveSheet.Unprotect ("bu")
If Dir(spath, 16) = "" Then MkDir (spath)
Application.Wait (Now + TimeValue("0:00:04"))
speichername = azubiname & "_" & was & "_" & wann & ".pdf"
ActiveSheet.Range("timestamp").Value = Format(Now(), "DD.MM.YY_hh:mm")
ChDir (spath)
Application.Wait (Now + TimeValue("0:00:04"))
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=speichername, Quality:= _
xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
ActiveSheet.Protect ("bu")
Application.ScreenUpdating = True
'Call Drucken
Worksheets("Start").Activate
End Sub
Anzeige