Speed of searching

[Marcw]

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.

 

[Steve Rindsberg]

I have recently ported some VBA code

Replied to earlier ... have a look back up a page or two