Automatisch geöffnete PPS. Pfad in Zelle Schreiben
Sascha
Hoffe das mir hier jemand bei dem Problem helfen kann.
Ich Habe eine Excel Datei die Automatisch eine PPS Datei Öffnet ist es möglich denn Pfad der PPS Datei in die Zelle C zu schreiben.
Grüsse Sascha
Private Function fcReadFiles() As Boolean
Dim lstrFile As String, loZeile As Long
lstrFile = Dir(ThisWorkbook.Path & "\*.pps")
If lstrFile = "" Then Exit Function
Columns("A:A").ClearContents
Do Until lstrFile = ""
loZeile = loZeile + 1
Range("A" & loZeile).Value = ThisWorkbook.Path & "\" & lstrFile
lstrFile = Dir
Loop
fcReadFiles = True
End Function
Sub sbStart()
If fcReadFiles = True Then
sbZufall
End If
End Sub
Private Sub sbZufall()
Dim loAnzahl As Long, loZeile As Long
Dim objPowerpoint As Object
loAnzahl = Cells(Rows.Count, 1).End(xlUp).Row
Randomize
loZeile = Int((loAnzahl * Rnd) + 1)
Set objPowerpoint = CreateObject("Powerpoint.Application")
objPowerpoint.Visible = True
objPowerpoint.Presentations.Open Filename:=Range("A" & loZeile).Value, ReadOnly:=msoFalse
End Sub