AW: Speicherung unterschidlicher Formate
18.06.2021 14:52:01
ChrisL
Hi
Ich empfehlen den FolderPicker und xlsm Format (xls stammt aus Excel 97).
Sub speichern_unter()
Dim lw_pfad As String, strDateiname As String
With ThisWorkbook.Worksheets("Kalkulazion")
lw_pfad = .Range("L2")
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = lw_pfad
.Title = "Datei speichern unter..."
.ButtonName = "Pfad auswählen. Neuer Pfad wird in L2 gespeichert."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
lw_pfad = .SelectedItems(1)
If Right(lw_pfad, 1) "\" Then lw_pfad = lw_pfad & "\"
Else
lw_pfad = ""
End If
End With
If lw_pfad = "" Then
MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben."
Else
.Range("L2").Value = lw_pfad
strDateiname = .Range("C6").Value & .Range("C5").Value
ThisWorkbook.SaveAs lw_pfad & strDateiname & ".xlsm"
MsgBox "Die Datei wurde unter " & lw_pfad & strDateiname & ".xlsm gespeichert.", , "OK"
ThisWorkbook.Worksheets(2).ExportAsFixedFormat Type:=xlTypePDF, Filename:=lw_pfad & strDateiname & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
ThisWorkbook.Worksheets(3).ExportAsFixedFormat Type:=xlTypePDF, Filename:=lw_pfad & strDateiname & "-VDB.pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End If
End With
End Sub
cu
Chris