Этот Код срабатывает 49 раз, но в 50-й раз возникает ошибка, отмеченная в данной строке (почти в конце кода). Не знаю почему, потому что 49 раз программа находит путь… Может, вы понимаете почему. Спасибо за помощь
Sub Excel_to_Powerpoint()
Dim pptPres As PowerPoint.Presentation
Dim pptApp As Object
Dim pptVorlage As String
Dim Speicher1 As String
Dim Speicher2 As String
Dim fso As FileSystemObject
Dim i As Integer
For i = 1 To 1200
If Sheets(1).Cells(6 + i, 5) = "" Then
Else
Set fso = New FileSystemObject
pptVorlage = "D:\Users\BKU\CedricWirth\Desktop\DHBW_Mosbach\T2000\Test\VorlagePSB.potx"
Set pptApp = CreateObject("Powerpoint.Application")
pptApp.Visible = True
pptApp.Activate
Set pptPres = pptApp.Presentations.Open(pptVorlage)
pptPres.Slides(1).Select
pptPres.Slides(1).Shapes("Projektnummer").TextFrame.TextRange.Characters.Text = Sheets(1).Cells(6 + i, 5).Value
Speicher1 = "D:\Users\BKU\CedricWirth\Desktop\DHBW_Mosbach\T2000\Test\Projektsteckbriefe\Projektsteckbrief_" & Sheets(1).Cells(6 + i, 5) & "_" & Sheets(1).Cells(6 + i, 13) & ".pptx"
Speicher2 = "D:\Users\BKU\CedricWirth\Desktop\DHBW_Mosbach\T2000\Test\Projektsteckbriefe\Projektsteckbrief2_" & Sheets(1).Cells(6 + i, 5) & ".pptx"
pptPres.SaveAs (Speicher2)
If fso.FileExists(Speicher1) = True Then
Call fso.DeleteFile(Speicher1)
pptPres.Close
Set pptPres = Nothing
pptApp.Quit
Set pptApp = Nothing
Call fso.Movefile(Speicher2, Speicher1)
Else
pptPres.Close
Set pptPres = Nothing
pptApp.Quit
Set pptApp = Nothing
Call fso.Movefile(Speicher2, Speicher1) "Here is the Error"
End If
End If
Next i
End Sub