.pptx aus Excel speichern
09.01.2018 15:28:29
MB12
beim Eingang eines neuen Auftrags lege ich per Makro (Ausschnitt siehe unten) einen neuen Projektordner an.
Dann bearbeite (Workbooks.Open) + speichere ich 3 "Vorlage"-Dateien in diesem Ordner.
Jetzt soll eine neue Datei dazukommen, diesmal aber eine Powerpoint-Präsentation, die nicht geöffnet,
sondern nur unter neuem Namen - wiederum in diesen Ordner - gespeichert werden soll.
Quelldatei: "X:\ALS\12_Projekte+VK-Preise\Vorlage_Projektnachbesprechung (APAL + BWCO).pptx"
Neuer Name: Range("A1").Text & " " & Range("B1").Text & " " & "Projektnachbesprechung" & ".pptx"
Bitte nicht wundern, aber ich komme nicht auf die Lösung, Hilfe wäre sehr willkommen :-)
Danke herzlich im Voraus
Gruß, Margarete
Option Explicit
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
ByVal DirPath As String) As Long
Private Sub CommandButton1_Click()
Dim strPath As String, strFile As String, strPathNew As String, strDir As String
strFile = Range("A1").Text & " " & Range("B1").Text & " " & "Ablaufplan" & ".xlsm"
strPath = "X:\ALS\12_Projekte+VK-Preise\" & Cells(1, 5).Text & "\"
strDir = Range("A1").Text & " " & Range("B1").Text
strPathNew = strPath & strDir & "\"
If CBool(MakeSureDirectoryPathExists(strPathNew)) Then
ThisWorkbook.SaveAs Filename:=strPathNew & strFile
Else
MsgBox "Fehler beim anlegen des Pfades: " & strPath
End If
End Sub
Private Sub CommandButton2_Click()
Dim owb1 As Workbook
Dim owb2 As Workbook
Dim owb3 As Workbook
Dim lletzte As Long
Dim strPfad As String, strPfadNeu As String, strDir As String, strFile As String
strPfad = "X:\ALS\12_Projekte+VK-Preise\" & Cells(1, 5).Text & "\"
strDir = Range("A1").Text & " " & Range("B1").Text
strPfadNeu = strPfad & strDir & "\"
Set owb1 = ThisWorkbook 'Arbeitsmappe mit diesem Code
'Neue Dateien erzeugen:
Set owb2 = Workbooks.Open("X:\ALS\12_Projekte+VK-Preise\Vorlage Auftragseingangsformular.xlsm")
Set owb3 = Workbooks.Open("X:\ALS\12_Projekte+VK-Preise\Vorlage Maschinenpreise VK_PPMS_2018. _
xlsm")
Set owb4 = Workbooks.Open("X:\ALS\12_Projekte+VK-Preise\Vorlage Ampel für PNB.xlsm")
'Bearbeitung der Vorlagen
'Neue Dateien im gleichen Ordner speichern:
strFile = Range("A1").Text & " " & Range("B1").Text & " " & "Auftragseingangsformular" & ".xlsm" _
owb2.SaveAs Filename:=strPfadNeu & strFile
strFile = Range("A1").Text & " " & Range("B1").Text & " " & "Maschinenpreise" & ".xlsm"
owb3.SaveAs Filename:=strPfadNeu & strFile
strFile = Range("A1").Text & " " & Range("B1").Text & " " & "Ampel für PNB" & ".xlsm"
owb4.SaveAs Filename:=strPfadNeu & strFile
End Sub