Ich habe Code von dieser Site verwendet, um ein Makro zu erstellen, mit dem eine Stichwortsuche in Word-Dokumenten durchgeführt und die Ergebnisse hervorgehoben werden können.

Ich möchte den Effekt in PowerPoint replizieren.

Hier ist mein Code für Word.

Sub HighlightKeywords()

Dim range As range
Dim i As Long
Dim TargetList

TargetList = Array("keyword", "second", "third", "etc") ' array of terms to search for

For i = 0 To UBound(TargetList) ' for the length of the array

   Set range = ActiveDocument.range

   With range.Find ' find text withing the range "active document"
   .Text = TargetList(i) ' that has the words from the array TargetList
   .Format = True ' with the same format
   .MatchCase = False ' and is case insensitive
   .MatchWholeWord = True ' and is not part of a larger word
   .MatchAllWordForms = False ' and DO NOT search for all permutations of the word

   Do While .Execute(Forward:=True)
   range.HighlightColorIndex = wdYellow ' highlight the keywords from the for loop yellow

   Loop

   End With
Next

End Sub

Hier ist, was ich bisher in PowerPoint habe, es ist in keiner Weise funktionsfähig.

Sub HighlightKeywords()

Dim range As range
Dim i As Long
Dim TargetList

TargetList = Array("keyword", "second", "third", "etc") ' array of terms to search for

For Each sld In Application.ActivePresentation.Slides

For Each shp In sld.Shapes

    If shp.HasTextFrame Then

        Set txtRng = shp.TextFrame.TextRange

For i = 0 To UBound(TargetList) ' for the length of the array

   With range.txtRng ' find text withing the range "shape, text frame, text range"
   .Text = TargetList(i) ' that has the words from the array TargetList
   .Format = True ' with the same format
   .MatchCase = False ' and is case insensitive
   .MatchWholeWord = True ' and is not part of a larger word
   .MatchAllWordForms = False ' and DO NOT search for all permutations of the word

   Do While .Execute(Forward:=True)
   range.HighlightColorIndex = wdYellow ' highlight the keywords from the for loop yellow

   Loop

   End With
Next

End Sub

Am Ende fand ich meine Antwort über die MSDN, aber sie war sehr nahe an der Antwort, die ich aus den eingereichten Beiträgen als richtig ausgewählt hatte.

Hier ist der Code, mit dem ich gegangen bin:

Sub Keywords()

Dim TargetList
Dim element As Variant

TargetList = Array("First", "Second", "Third", "Etc")

For Each element In TargetList
   For Each sld In Application.ActivePresentation.Slides
      For Each shp In sld.Shapes
         If shp.HasTextFrame Then
            Set txtRng = shp.TextFrame.TextRange
            Set foundText = txtRng.Find(FindWhat:=element, MatchCase:=False, WholeWords:=True)
            Do While Not (foundText Is Nothing)
               With foundText
                  .Font.Bold = True
                  .Font.Color.RGB = RGB(255, 0, 0)
               End With
            Loop
         End If
      Next
   Next
Next element

End Sub

Es stellte sich heraus, dass der Code funktioniert hat, aber es war ein wahrer Albtraum. Der Code, den ich als die richtige Antwort unten ausgewählt habe, läuft viel reibungsloser. Ich habe mein Programm an die gewählte Antwort angepasst.