Private Sub Workbook_Open()
Dim sourceFileName As String
Dim oldFilePath1 As String
Dim newFilePath1 As String
Dim oldFilePath2 As String
Dim newFilePath2 As String
Dim testnumber As String
sourceFileName = ThisWorkbook.Sheets("Sheet1").Cells(1, 1).Value
newFilePath1 = ThisWorkbook.Sheets("Sheet1").Cells(6, 1).Value
testnumber = ThisWorkbook.Sheets("Sheet1").Cells(8, 1).Value
If Len(newFilePath1) = 0 Then
Else
Select Case testnumber
Case 1
oldFilePath1 = "D:\Users\187\Documents\Templates\_1\01_Ausgewertet.xls"
Case 2
oldFilePath1 = "D:\Users\187\Documents\Templates\_2\01_Ausgewertet.xls"
Case 3
oldFilePath1 = "D:\Users\187\Documents\Templates\_3\01_Ausgewertet.xls"
Case 4
oldFilePath1 = "D:\Users\187\Documents\Templates\_4\01_Ausgewertet.xls"
Case 5
oldFilePath1 = "D:\Users\187\Documents\Templates\_5\01_Ausgewertet.xls"
End Select
Dim pptApp As PowerPoint.Application
Dim pptPresentation As Object
Dim pptSlide As Object
Dim pptShape As Object
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
Set pptApp = New PowerPoint.Application
pptApp.Visible = True
Set pptPresentation = pptApp.Presentations.Open(sourceFileName)
For Each pptSlide In pptPresentation.Slides
For Each pptShape In pptSlide.Shapes
If pptShape.Type = msoLinkedPicture Or pptShape.Type _ = msoLinkedOLEObject Then
pptShape.LinkFormat.SourceFullName = Replace(LCase _ (pptShape.LinkFormat.SourceFullName),
LCase(oldFilePath1), newFilePath1)
End If
Next
Next
pptPresentation.UpdateLinks
pptPresentation.Save
pptPresentation.Close
pptApp.Quit
Set pptApp = Nothing
Set pptPresentation = Nothing
Set pptSlide = Nothing
Set pptShape = Nothing
SecondsElapsed = Round(Timer - StartTime, 2)
End If
End Sub