VBA Datei als Excel- und PDF-Datei speic
16.04.2021 11:26:57
Hawk
ich fasse in einer Exceldatei, Daten vom mehreren Tabellenblättern auf einem Tabellenblatt(Druck) zusammen.
Dieses Blatt (Druck) möchte ich nun als *.xslm und *.pdf über VBA abspeichern.
In Zelle "R1" wird der Dateiname und in "R2" der Dateipfad generiert.
Beim Ausführen des Marcos öffnet sich ein Eingabefenster, welches den Speicherpfad abfragt.
Hier wird immer der eingetragene Pfad aus "R2" vorgeschlagen, kann aber geändert werden
(diese Änderung wird auch in "R2" übernommen).
Dann folgt ein Prüfung ob der Pfad vorhanden ist und legt diesen ggf. an.
Bis zu diesem Punkt funktioniert alles richtig.
Mein Problem liegt darin, dass sollte der Ordnerpfad nicht vorhanden sein, wird dieser
korrekt angelegt und die Excel-Datei auch richtig erstellt, aber die PDF-Datei nicht.
Ist der Ordnerpfad jedoch vorhanden, erstellt er beide Dateien ohne Probleme im gewünschten Ordnerpfad.
Hier das Macro
Sub Testfeld3()
Dim Speicherpfad As String
Dim Antwort As Integer
Dim SpeicherName As String
Speicherpfad = ActiveSheet.Range("R2").Value
SpeicherName = Speicherpfad & ActiveSheet.Range("R1").Value & ".pdf"
Speicherpfad = InputBox("Gebt bitte hier das Laufwerk und den Pfad an (siehe Beschreibung in _
Teams), wo die Datei gespeichert werden soll." & Chr(13) & Chr(13) _
& "(Die Eingabe wird in R2 gespeichert.)", "Datei speichern unter...", Speicherpfad) _
If Right(Speicherpfad, 1) "\" Then Speicherpfad = Speicherpfad & "\"
If Dir(Speicherpfad, vbDirectory) "" Then
Else
Antwort = MsgBox("Der Ordner " & Speicherpfad & " ist nicht vorhanden." _
& vbNewLine _
& "soll der Ordner angelegt werden?!", vbYesNo)
If Antwort = vbYes Then
MkDir Speicherpfad
MsgBox "Ordner " & Speicherpfad & " angelegt"
Else
MsgBox "Es wurden keine Änderungen vorgenommen"
Exit Sub
End If
If Speicherpfad = "" Then
MsgBox "Die Datei wird nicht gespeichert, da Du [Abbrechen] gedrückt oder nichts eingegeben _
hast.", , "Abbruch"
Exit Sub
End If
End If
If Right(Speicherpfad, 1) "\" Then Speicherpfad = Speicherpfad & "\"
ActiveSheet.Range("R2").Value = Speicherpfad
Rem MsgBox Speicherpfad
ActiveWorkbook.SaveAs Speicherpfad & ActiveSheet.Range("R1").Value & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF _
, Filename:=SpeicherName, Quality:=xlQualityStandard, IncludeDocProperties:=True _
, IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox "Die Datei wurde unter " & Speicherpfad & ActiveSheet.Range("R1").Value & ".xlsm _
gespeichert.", , "OK"
Range("A1").Select
End Sub
Vielen Dank für Eure Hilfe