Not sure you really need an array at all
It might look like this though:
It might be simpler to do this:Sub findWord() Const FINDTHIS As String = "Whatever" Dim i As Integer Dim osld As Slide Dim oshp As Shape Dim raySlides() As Long Dim strResult As String Dim foundText As TextRange Dim txRange As TextRange ReDim raySlides(1 To 1) For Each osld In ActivePresentation.Slides For Each oshp In osld.Shapes If oshp.HasTextFrame Then If oshp.TextFrame.HasText Then Set txRange = oshp.TextFrame.TextRange Set foundText = txRange.Find(FindWhat:=FINDTHIS) Do While Not (foundText Is Nothing) With foundText raySlides(UBound(raySlides)) = osld.SlideIndex ReDim Preserve raySlides(1 To UBound(raySlides) + 1) Exit For End With Loop End If End If Next oshp Next osld If UBound(raySlides) > 1 Then For i = 1 To UBound(raySlides) - 1 If i < UBound(raySlides) - 1 Then strResult = strResult & CStr(raySlides(i)) & "/" Else strResult = strResult & CStr(raySlides(i)) End If Next i End If MsgBox strResult End Sub
Both might need a little workSub findWord2() Const FINDTHIS As String = "Whatever" Dim i As Integer Dim osld As Slide Dim oshp As Shape Dim strResult As String Dim foundText As TextRange Dim txRange As TextRange For Each osld In ActivePresentation.Slides For Each oshp In osld.Shapes If oshp.HasTextFrame Then If oshp.TextFrame.HasText Then Set txRange = oshp.TextFrame.TextRange Set foundText = txRange.Find(FindWhat:=FINDTHIS) Do While Not (foundText Is Nothing) With foundText strResult = strResult & CStr(osld.SlideIndex) & "/" Exit For End With Loop End If End If Next oshp Next osld If strResult <> "" Then strResult = Left(strResult, Len(strResult) - 1) MsgBox strResult End Sub





Reply With Quote
