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)
Call DateispeichernmitKW
End Sub
Private Function GetValue(pfad, datei, blatt, bezug)
Dim arg As String
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
If Dir(pfad & datei) = "" Then
GetValue = "File Not Found"
Exit Function
End If
arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & _
Range(bezug).Range("D3").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
End Function
Sub DateispeichernmitKW()
Dim pfad2 As String
Dim dateiname As String
pfad2 = "PfadFürDieNeuePPDatei"
dateiname = "speicherversuch"
Application.DisplayAlerts = ppAlertsNone
ActivePresentation.SaveCopyAs Filename:=pfad2 & dateiname & KW & ".pptm", FileFormat:=ppSaveAsOpenXMLPresentationMacroEnabled
Application.DisplayAlerts = ppAlertsAll
End Sub