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
|