Wert einer Zelle aus geschlossener Excel Tabelle in Powepoint VBA benutzen
28.11.2019 15:38:32
Olli
Und zwar möchte ich einen Code in PowerPoint dafür schreiben, dass ich die Kopie einer PowerPoint Präsentation mit neuem Namen an einem neuen Ort speichern kann.
Dazu soll aber ein Wert einer Zelle, den ich gerne aus einer geschlossenen Excel Tabelle auslesen möchte, mit in den Dateinamen der neuen Präsentation gespeichert werden (in meinem Fall die Kalenderwoche).
Die Routine zum Dateispeichern ("DateispeichernmitKW") funktioniert bereits ohne Probleme, jedoch ohne die gewünschte KW im Dateinamen. Soweit ich weiß, ist die Funktion GetValue fehlerhaft und ich glaube es liegt daran, dass ich manche Variablen falsch definiert habe (vor Allem: Rng).
Es ist vielleicht wichtig nochmal zu erwähnen, dass ich den Code in PowerPoint und nicht in Excel schreibe.
Ich hoffe ihr habt mein Problem soweit verstanden und ich freue mich über Hilfe!
Gruß Olli
Hier der Code:
-------------------------------------------------------------------------------------------------------------------------------------------------
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 'Speicherroutine laufen lassen
End Sub
Private Function GetValue(pfad As String, datei As String, blatt As String, bezug As String)
Dim Rng As Range
With CreateObject("Excel.Application")
With .Workbooks.Open(pfad & "\" & datei).Sheets(blatt)
Set Rng = .Range(bezug)
GetValue = Rng.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 = "PfadFürDieNeuePPTM"
dateiname = "speicherversuch"
Application.DisplayAlerts = False
PPT.ActivePresentation.SaveCopyAs FileName:=pfad2 & dateiname & KW & ".pptm" 'Neue Powerpoint abspeichern mit Name+KW aus der Excl
Application.DisplayAlerts = True
End Sub