I have an end user who is Visually Handicapped. He uses Word 2016 on a daily basis. He is pretty adept with Word, but he is having a problem with the Search and Find Feature. He needs to be able to search, and be able to go to each hit and modify as he reviews the narrative. Once he reviews the first hit, he would use a function key to go to the next hit. He needs this to work in all StoryRanges, including header and footer. He does not want the find box to popup.
I have a script which has him enter his search term, then highlight all the terms in the document, in all StoryRanges. My dilemma is moving through the document. In essence, he should be able to enter the search term and the word should be highlighted where he can change or keep as is. In either case, once he makes his choice, the highlight would be removed, and the a Function key should take him to the next hit until all have been handled.
I found the script below will do a Find and Replace, but I just need a FIND ONLY.
Public Sub FindReplaceAnywhere()
Dim rngStory As Word.Range
Dim pFindTxt As String
Dim pReplaceTxt As String
Dim lngJunk As Long
Dim oShp As Shape
pFindTxt = InputBox("Enter the text that you want to find." _
, "FIND" )
If pFindTxt = "" Then
MsgBox "Cancelled by User"
pReplaceTxt = InputBox( "Enter the replacement." , "REPLACE" )
If pReplaceTxt = "" Then
If MsgBox( "Do you just want to delete the found text?", _
vbYesNoCancel) = vbNo Then
ElseIf vbCancel Then
MsgBox "Cancelled by User."
'Fix the skipped blank Header/Footer problem
lngJunk = ActiveDocument.Sections( 1 ).Headers( 1 ).Range.StoryType
'Iterate through all story types in the current document
For Each rngStory In ActiveDocument.StoryRanges
'Iterate through all linked stories
SearchAndReplaceInStory rngStory, pFindTxt, pReplaceTxt
On Error Resume Next
Select Case rngStory.StoryType
Case 6 , 7 , 8 , 9 , 10 , 11
If rngStory.ShapeRange.Count > 0 Then
For Each oShp In rngStory.ShapeRange
If oShp.TextFrame.HasText Then
SearchAndReplaceInStory oShp.TextFrame.TextRange, _
On Error GoTo 0
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Public Sub SearchAndReplaceInStory(ByVal rngStory As Word.Range, _
ByVal strSearch As String , ByVal strReplace As String )
.Text = strSearch
.Replacement.Text = strReplace
.Wrap = wdFindContinue
Any assistance is appreciated.