|
So, ich habe das Problem behoben und so sieht der funktionierende Code aus, falls ihn auch mal jemand benötigen sollte :)
Gruß Olli
Option Explicit
Public KW As Variant
Sub Zelleauslesen()
Dim pfad As String, datei As String, blatt As String, bezug As String
pfad = "MeinPfadDerExcelTabelle"
datei = "Status ?bersichtstabelle.xlsx"
blatt = "copy paste Tabellen"
bezug = "D3"
KW = GetValue(pfad, datei, blatt, bezug) 'Wert aus Zelle D3 in der Excl als KW speichern
Call DateispeichernmitKW
End Sub
Private Function GetValue(pfad As String, datei As String, blatt As String, bezug As String) As String
With CreateObject("Excel.Application")
With .Workbooks.Open(pfad & "\" & datei)
GetValue = .Sheets(blatt).Range(bezug).Value
End With
.Quit
End With
End Function
Sub DateispeichernmitKW()
Dim PPT As PowerPoint.Application
Dim pfad2 As String
Dim dateiname As String
Set PPT = New PowerPoint.Application
pfad2 = "PfadDerNeuenPPTM"
dateiname = "speicherversuch"
Application.DisplayAlerts = False
PPT.ActivePresentation.SaveCopyAs FileName:=pfad2 & dateiname & KW & ".pptm" 'Neue Powerpoit abspeichern mit Name+KW aus der Excl
Application.DisplayAlerts = True
End Sub
|