Russ,
I was too far into my own crude solution to back up and take a hard look at
yours. Perhaps if this was a process that "I" really needed I might give if
the extra effort.
I have scratched together some crude code that appears to do what I
understood the OP requested:
'Run from Menu, hotkey or toobar
Sub RunMan()
ReadWords False
End Sub
'Run from Menu, hotkey or toobar
Sub RunAuto()
ReadWords True
End Sub
Sub ReadWords(ByRef bTest As Boolean)
Dim oRng As Word.Range
Dim wdsDoc As Words
Dim i As Long
Dim strPause As String
Dim bAutoTimed As Boolean
Dim pRng As Word.Range
Set oRng = ActiveDocument.Range
oRng.Start = Selection.Range.Start
bAutoTimed = bTest
Set wdsDoc = oRng.Words
If bAutoTimed Then
Do
strPause = InputBox("How long would you like to wait for each word?",
"Set Timer ")
Loop While Not IsNumeric(strPause)
For i = 1 To wdsDoc.Count
With wdsDoc(i)
If Not .Characters(1) Like "[!A-Za-z]" Then
wdsDoc.Item(i).Select
ActiveWindow.ScrollIntoView Selection.Range, True
Selection.Collapse wdCollapseEnd
.HighlightColorIndex = wdYellow
.Bold = True
.Font.Size = .Font.Size + 6
Application.ScreenRefresh
WaitABit CSng(strPause)
DoEvents
ActiveDocument.UndoClear
Application.ScreenRefresh
.HighlightColorIndex = wdNoHighlight
.Bold = False
.Font.Size = .Font.Size - 6
End If
End With
Next
Else
For i = 1 To wdsDoc.Count
With wdsDoc(i)
If Not .Characters(1) Like "[!A-Za-z]" Then
.Select
Exit For
End If
End With
Next
On Error GoTo Err_Handler
Set pRng = wdsDoc(i)
pRng.Start = ActiveDocument.Range.Start
With pRng.Find
.Font.Bold = True
.Highlight = True
.Font.Size = Selection.Font.Size + 6
While .Execute
With pRng
If .HighlightColorIndex = wdYellow Then
.Font.Bold = False
.HighlightColorIndex = wdNoHighlight
.Font.Size = .Font.Size - 6
End If
End With
Wend
End With
ActiveWindow.ScrollIntoView Selection.Range, True
With wdsDoc(i)
.HighlightColorIndex = wdYellow
.Font.Bold = True
.Font.Size = Selection.Font.Size + 6
.Collapse wdCollapseEnd
End With
Selection.Collapse wdCollapseEnd
Application.ScreenRefresh
End If
Exit Sub
Err_Handler:
'When there are no more valid words an error will occur. _
'Now need to figure out how to clean up last highlighted word.
End Sub
Sub WaitABit(sngWaitSecs As Single)
Dim myDate As Date
myDate = Timer
Do
Loop Until (Timer - myDate) > sngWaitSecs
End Sub
One nagging issue remains. When stepping through manually went there are no
more valid words the code will throw and error (a good thing). I need to
figure out how to clear the special formatting on the last word processed.
I am done for now but would be interested in what others might do with this.
--
Greg Maxey/Word MVP
See:
http://gregmaxey.mvps.org/word_tips.htm
For some helpful tips using Word.
Greg,
One way to do 2 might be to create a userform the size of a single
resume button that gets placed in the upper left corner of the screen
when strPause = 0 and tested for in the WaitABit sub. On my MacWord
2004, at home now, I can't export the .bas , .frm, and frx files to
post such a userform code. But if it shown modal then it should pause
the loop code.
I think this takes care of 1 and 3. Haven't had time to think about
2 yet. Sub ReadWords()
Dim oRng As Word.Range
Dim wdsDoc As Words
Dim i As Long
Dim strPause As String
Do
strPause = InputBox("How long would you like to wait for each
word?", "Set Timer ")
Loop While Not IsNumeric(strPause)
Set oRng = ActiveDocument.Range
oRng.Start = Selection.Range.Start
Set wdsDoc = oRng.Words
For i = 1 To wdsDoc.Count
With wdsDoc(i)
If Not .Characters(1) Like "[!A-Za-z]" Then
wdsDoc.Item(i).Select
ActiveWindow.ScrollIntoView Selection.Range, True
Selection.Collapse wdCollapseEnd
.HighlightColorIndex = wdYellow
.Bold = True
.Font.Size = .Font.Size + 6
Application.ScreenRefresh
WaitABit CSng(strPause)
DoEvents
ActiveDocument.UndoClear
Application.ScreenRefresh
.HighlightColorIndex = wdNoHighlight
.Bold = False
.Font.Size = .Font.Size - 6
End If
End With
Next
End Sub
Sub WaitABit(sngWaitSecs As Single)
Dim myDate As Date
myDate = Timer
Do
Loop Until (Timer - myDate) > sngWaitSecs
End Sub
