To: Dusty,
Take a look at the following:
'
' Test FindInLine
'
Sub TestFindInLine()
Dim newDoc As Document
Dim oRange As Range
Dim linesRange As Range
Dim sDummyText As String
Dim sFind(1 To 3) As String
Dim nIndex As Long
Set newDoc = Documents.Add
Set oRange = newDoc.Range
sFind(1) = "no less than 65 properties"
sFind(2) = "in addition"
sFind(3) = "contguous"
'The next line is very long
sDummyText = "The range object represents a contiguous area within a
Word document. But in addition, the range object has no less than 65
properties, only one of which is the text property. Although a range can work
with any part of a document, it is more difficult to work with pages or lines
than it is to work with paragraphs, sentences, or words. The reason for this
is that while VBA has collections for sections, paragraphs, sentences, words,
and characters, there are no collections for pages and lines. My guess would
be that a page doesn't fit into a logical hierarchy, since sections,
paragraphs, sentences, and even words, break across pages and lines.
Nonetheless, it is possible to work with pages and lines."
oRange.Text = sDummyText & vbCr & sDummyText
Set linesRange = FindRangeOfLines(oRange, 10)
linesRange.Select
MsgBox "10 Lines"
For nIndex = 1 To 3
Set oRange = FindInRange(linesRange, sFind(nIndex))
If Not oRange Is Nothing Then
oRange.Select
MsgBox "Found: " & oRange.Text
oRange.Collapse wdCollapseEnd
oRange.Select
Else
MsgBox "Did not find: " & sFind(nIndex)
End If
Next nIndex
linesRange.Select
MsgBox "10 Lines"
End Sub
'
' FindRangeOfLines a number of lines within a range
' I couldn't get "ByVal" to work with ranges
' so I'm adding: Set lnRange = oRange.Duplicate
'
Function FindRangeOfLines(oRange As Range, ByVal nNumberOfLines) As Range
Dim nEnd As Long
Dim nStart As Long
Dim nLnEnd As Long
Dim nCount As Long
Dim lnRange As Range
Set lnRange = oRange.Duplicate
nEnd = oRange.End
nStart = oRange.Start
lnRange.Collapse wdCollapseStart
lnRange.Select
Set lnRange = oRange.Parent.Bookmarks("\line").Range
lnRange.Move wdCharacter, 1
nLnEnd = lnRange.End
While (nLnEnd < nEnd And nCount < nNumberOfLines)
nCount = nCount + 1
lnRange.Select
Set lnRange = oRange.Parent.Bookmarks("\line").Range
lnRange.Move wdCharacter, 1
nLnEnd = lnRange.End
Wend
lnRange.Start = nStart
Set FindRangeOfLines = lnRange
End Function
'
' FindInRange finds a string within a range
' I couldn't get "ByVal" to work with ranges
' so I'm adding: Set fRange = findRange.Duplicate
'
Function FindInRange(findRange As Range, ByVal sStr As String) As Range
Dim fRange As Range
Set fRange = findRange.Duplicate
Dim nPos As Long
nPos = InStr(fRange.Text, sStr)
If nPos > 0 Then
fRange.Start = fRange.Start + nPos - 1
fRange.End = fRange.Start + Len(sStr)
Set FindInRange = fRange
Else
Set FindInRange = Nothing
End If
End Function
Steven Craig Miller
