Hallo zusammen, 

ich hab hier einen code der automatisch mit Daten aus einem Excel PPT erzeugt und wollte fragen ob das auch einfacher geht anstatt so viele schleifen machen zu müssen.

Hierbei gehts darum das er Daten aus dem Feld "text1" + die passende schriftgröße "size1" auslesen und einfügen soll.

Das geht hoch insgesammt bis text40 und size40 - kann man das irgendwie einfacher machen anstatt 40 Schleifen?

BTW: sind die Texte nicht alle auf der gleicher PPT slide. bspw sind die ersten 10 texte auf slide 2, die nächsten 10 auf slide 3 usw.

Sub sheet1()

Dim pptPres As Presentation     'Die PowerPoint-Präsentation
Dim strPfad As String           'Speicherpfad und Ort der Vorlage
Dim strPPTX As String           'Name der Vorlage
Dim pptApp As Object

    strPfad = "C:\Users\DE116832\Desktop\"
    strPPTX = "test.pptx"
    pptVorLage = strPfad & strPPTX
    
    
    
    Set pptApp = New PowerPoint.Application
    
    pptApp.Presentations.Open Filename:=pptVorLage, untitled:=msoTrue
    
    Set pptPres = pptApp.ActivePresentation
    
    pptPres.Slides(1).Select
    

  With pptPres.Slides(2).Shapes("text1").TextFrame.TextRange
       
    Call Range("text1").Copy
    Call .Paste
    
    If Range("text1").Font.Size Then
      .Font.Size = Range("size1")
   End If
      
  End With
  
  With pptPres.Slides(2).Shapes("text2").TextFrame.TextRange
       
    Call Range("text2").Copy
    Call .Paste
    
    If Range("text2").Font.Size Then
      .Font.Size = Range("size2")
   End If
    
  End With

    
      
    pptPres.SaveAs strPfad & Range("text1") & ".pptx"
    
    pptPres.Close
    pptApp.Quit
    
    Set pptPres = Nothing
    Set pptApp = Nothing

End Sub