Hallo steffesj,

mein Problem ist es, das ich keine Möglichkeit habe in einer einfachen Art und Weise die gewünschten (variablen) Begriffe in einem Text zu integrieren. Ich würde mir wünschen, das ich die oben angesprochen Variablen (z.b. $$ORT$$) innerhalb eines Textblocks (=shape) unterbringen kann. Dadurch hätte man den Vorteil, den Begriff nur einmal innerhalb einer Präsentation verändern zu müssen, und nicht überall einzeln. (vgl. Variablen_und_Konstanten)

Aktuelle Lösung:  3 innernader verschachtetlte Schleifen, d.h. die äußerste läuft durch die einzelnen zeilen der Excel_Source, die Schleife darunter über alle Folien, und die innerste Schleife über alle Shapes innerhalb der jeweiligen Folie.

Sub ReplaceText()
    'intialize variables
    Dim oSlide As Slide
    Dim oShape As Shape
    Dim oTxtRng As TextRange
    Dim oTmpRng As TextRange
    Dim strExcelFilePath As String
    Dim iCounter As Integer
    
    'Preparation to read Excel_Source file
    strExcelFilePath = ActivePresentation.Path & "\Excel_Source.xlsm"
    Set EX = CreateObject("Excel.Application")
    EX.Workbooks.Open FileName:=strExcelFilePath, ReadOnly:=True
    iCounter = 2
    
    NextValue = EX.Workbooks("Excel_Source.xlsm").Sheets(1).Cells(iCounter, 2)
    
    If IsEmpty(NextValue) Then
        MsgBox ("Warning! Cell B2 of 'Excel_Source.xlsm' is empty. Please check your input.")
    Else
        
        While Not IsEmpty(NextValue)
            'get data from excel source file
            'set words that has to be replaced from excel source file
            oFindThat = EX.Workbooks("Excel_Source.xlsm").Sheets(1).Cells(iCounter, 1)
            ORelpaceWithThis = EX.Workbooks("Excel_Source.xlsm").Sheets(1).Cells(iCounter, 2)
          
            'loop over every slide and shape
            For Each oSlide In Application.ActivePresentation.Slides
                For Each oShape In oSlide.Shapes
                    If oShape.HasTextFrame Then
                        Set oTxtRng = oShape.TextFrame.TextRange
                        'search for oFindThat and replace it with ORelpaceWithThis
                        Set oTmpRng = oTxtRng.Replace(oFindThat, ORelpaceWithThis)
                        Do While Not oTmpRng Is Nothing
                            Set oTxtRng = oTxtRng.Characters(oTmpRng.Start + oTmpRng.Length, oTxtRng.Length)
                            Set oTmpRng = oTxtRng.Replace(oFindThat, ORelpaceWithThis)
                        Loop
                    End If
                Next oShape
            Next oSlide
            iCounter = iCounter + 1
            NextValue = EX.Workbooks("Excel_Source.xlsx").Sheets(1).Cells(iCounter, 2)
        Wend 'End of WhileLoop
    End If
    EX.Quit
End Sub