I have recently ported some VBA code that checks Word documents for
misspellings, incorrect terminology, etc. to PowerPoint and discovered
the limitations of the PPT object model compared to Word. I am looping
through the presentations by Slide, Shape, looking for TextFrames and
TextRanges, etc.  for both slides and Notes and have found the entire
process to be extremely slow.

There are about 950 rules being processed. My test presentation is 19
slides with notes on just about each page and takes 10-12 minutes.  In
Word checking a 54 page document took a little over 2 minutes. The
Notes checking appears to be taking the most time, but there is a lot
of text in these notes.

Are there any hints on speeding this up?

Here's the relevant code:

Private Function myFind(SlideNum As Integer, ShapeNumber As Integer,
ViewType As Integer) As Boolean

       Set sld = Application.ActivePresentation.Slides(nSld)
       If ActiveWindow.ViewType = ppViewNotesPage Then GoTo NotesPage
       ActiveWindow.ViewType = ppViewSlide
       ' Loop through each shape on each slide.
       For nShp = ShapeNumber To sld.Shapes.Count
           Set shp = sld.Shapes(nShp)
           If shp.HasTextFrame And shp.TextFrame.HasText Then
               Set txtRng = shp.TextFrame.TextRange
               Set foundText = txtRng.Find(FindWhat:=sFrom,
MatchCase:=CaseSens, WholeWords:=IsAlpha(sFrom))
               If Not (foundText Is Nothing) Then
                   If sTo <> "count" Then ScreenUpdating = True
                   ActiveWindow.View.GotoSlide index:=sld.SlideIndex
                   foundText.Select
                   myFind = True
                   ShapeType = Slide
                   If sTo = "count" Then
                       lcv = lcv + 1
                       Do While Not (foundText Is Nothing)
                           With foundText
                               Set foundText =
txtRng.Find(FindWhat:=sFrom, After:=.Start, _
                                       MatchCase:=CaseSens,
WholeWords:=IsAlpha(sFrom))
                               If Not (foundText Is Nothing) Then
                                   lcv = lcv + 1
                               End If
                           End With
                       Loop
                   Else
                       ScreenUpdating = True
                       Exit Function
                   End If
               End If
           End If
       Next nShp
NotesPage:
       If ActiveWindow.ViewType = ppViewSlide Then
           ShapeNumber = 1
           ActiveWindow.ViewType = ppViewNotesPage
       End If
       ' Loop through each shape on each slide.
       For nShp = ShapeNumber To sld.NotesPage.Shapes.Count
           Set shp = sld.NotesPage.Shapes(nShp)
           If shp.PlaceholderFormat.Type = ppPlaceholderBody Then
               If shp.HasTextFrame And shp.TextFrame.HasText Then
                   Set txtRng = shp.TextFrame.TextRange
                   Set foundText = txtRng.Find(FindWhat:=sFrom,
MatchCase:=CaseSens, WholeWords:=IsAlpha(sFrom))
                   If Not (foundText Is Nothing) Then
                       If sTo <> "count" Then ScreenUpdating = True
                       ActiveWindow.View.GotoSlide
index:=sld.SlideIndex
                       foundText.Select
                       myFind = True
                       ShapeType = Note
                       If sTo = "count" Then
                           lcv = lcv + 1
                           Do While Not (foundText Is Nothing)
                               With foundText
                                   Set foundText =
txtRng.Find(FindWhat:=sFrom, After:=.Start, _
                                           MatchCase:=CaseSens,
WholeWords:=IsAlpha(sFrom))
                                   If Not (foundText Is Nothing) Then
                                       lcv = lcv + 1
                                   End If
                               End With
                           Loop
                       Else
                           ScreenUpdating = True
                           Exit Function
                       End If
                   End If
               End If
           End If
       Next nShp
       ActiveWindow.ViewType = ppViewSlide
   Next nSld

Thanks,

Marc Wiener
Gartner, Inc.