Thanks for the prompt reply. After spending several days with the
KnowledgeBase, Excel and Word books it turns out that this is not a simple
question. When trying to execute a "find" in the word document from an Excel
Macro, the find did not execute and the returned "Find" results was always
blank. After conversing with the experts in the "Word Programming" forum,
their answer was to copy the text I whish to searh for into a seperate text
or word document and perform the "Find" using a Macro written for "Word".
This seemed to labor intensive for the function I wished to perform so I came
up with a third alternative which is to use a function written for the word
document and call the word function from excel. the code I use seems to work
so I thought I'd put it in here in case anyone would like to use it or
scrutinize it for a more elegant approach.
Here is the Excel Macro....
##########################################
Sub SearchForText()
'
' SearchForText Macro
'
'
Dim WordApp As Word.Application
Dim wordDoc As Document
Dim WordWasNotRunning As Boolean
Dim inRange As Range
Dim srcCell As Range
Dim srchResults As String
Dim srchStr As String
Dim tmp As Variant
WordWasNotRunning = False
'Get existing instance of Word if it's open; otherwise create a new one
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err Then
Set WordApp = New Word.Application
WordWasNotRunning = True
End If
On Error GoTo Err_Handler
WordApp.Visible = True
WordApp.Activate
WordApp.Application.ScreenUpdating = False
Set wordDoc = WordApp.Documents.Open("C:\MyPath\MyDoc.docx",
ReadOnly:=True)
On Error Resume Next
Set inRange = Worksheets(ActiveSheet.Name).Range("C2:C376")
inRange.Cells.Offset(0, 7).Value = ""
inRange.Cells.Offset(0, 7).Interior.ColorIndex = xlNone
For Each srcCell In inRange.Cells
srchResults = WordApp.Run("TextInstanceFind", srcCell.Text)
If srchResults = "" Then
srcCell.Offset(0, 7).Interior.Color = RGB(149, 55, 53)
Else
srcCell.Offset(0, 7).Value = srchResults
End If
Next srcCell
'Close the document
wordDoc.Close savechanges:=wdDoNotSaveChanges
If WordWasNotRunning Then
'Close Word
WordApp.Quit
End If
Set wordDoc = Nothing
Set WordApp = Nothing
Exit Sub
Err_Handler:
MsgBox "Word caused a problem. " & Err.Description, vbCritical, "Error:
" & Err.Number
If WordWasNotRunning Then
WordApp.Quit
End If
End Sub
And here is the Word Function....
##########################################
Function TextInstanceFind(srchStr As String) As String
'
' TextInstanceFindFunction
'
'
Dim foundStr As String
Selection.Start = 1
Selection.End = Selection.Start
Selection.Find.ClearFormatting
With Selection.Find
.Text = srchStr
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
While Selection.Find.Execute = True
' Move to the previous section to find out if the requirement in in a
' requirement list or in a procedure
Selection.MoveLeft
Selection.MoveLeft Unit:=wdCell, Count:=1
If Selection.Text = "Text that indicates that this selection should
be skipped" Then
'This is the wrong selection go to the next
Selection.MoveLeft
Selection.MoveRight Unit:=wdCell, Count:=1
If Selection.End Then
Selection.Start = Selection.End
End If
Else
'This is the correct selection. Go find the heading before
Selection.MoveLeft
Selection.Find.Text = ""
Selection.Find.Style = "Heading 5"
Selection.Find.Forward = False
Selection.Find.Execute
If foundStr = "" Then
foundStr = Selection.Range.ListFormat.ListString
Else
foundStr = foundStr + ", " +
Selection.Range.ListFormat.ListString
End If
' Get the heading number
Selection.Start = Selection.End
Selection.Find.Forward = True
If Selection.Find.Execute = False Then
Selection.Start = Selection.End
Selection.Find.Text = srchStr
Selection.Find.Style = "Normal"
Selection.Find.Forward = True
Selection.Find.Execute
Selection.Start = Selection.End
Else
Selection.MoveLeft
Selection.Find.Text = srchStr
Selection.Find.Style = "Normal"
Selection.Find.Forward = True
End If
End If
'No go to the end of the section and set up the next search
Wend
TextInstanceFind = foundStr
End Function
#######################################
The performance isn't great but it sure saves a lot of cut and paste. If
there is a way to enhance this, please let me know.
