TheAntiGates
02-26-2005, 03:54 PM
This is so you can in Word find, e.g., either Co. or company. Once you start using this you'll be hooked like I am - there are a million times it has paid off here. How about find for Bill or Billy or William?
My VBA skills are weakest with Word, so I'll be grateful if true experts will proceed to lock and load at it. There's some narrative along those lines in the comments in the code.
I have removed tons of whitespace below to shorten wide lines, which looks severe as I preview this. I have put in needless line continuation underscores for this too. It was fine in the VBA window :( (though my tabsize is 2)
'This is a nonwrapping FORWARD search for "OR" arguments, comma-separated.
'It IGNORES current selection (except to change it when the search succeeds).
'Notice that it uses the static variable sResp$, defined atop this module
'Dim sResp$
'Usage e.g.:
'Type(without the quotes)"a,e,i,o,u" in InputBox & it goes to next vowel
'Also beware that while debugging, CODE WINDOW is operated on, not
'the "active document"? - I'd sure love to know how to get around that
Sub CompoundFind() 'you're nuts not to keyboard accel. these two...
CompoundFindCommonCode (True)
End Sub
Sub CompoundFindNext()
CompoundFindCommonCode (False)
End Sub
Sub CompoundFindCommonCode(bPrompt As Boolean)
Dim iInitSelStart&, iInitSelEnd&, iCommaPos&, _
iSavPos&, iTrialPos&, iNewPos&, iNewPosLen&
Dim sstr$, bFound As Boolean, bLoopForBkSlash As Boolean
If bPrompt Then _
sResp$=InputBox$("Type multiple ' Or ' Find items, comma separated " _
& Chr(10) & "( Use \, for actual comma) ", "MultiFind", sResp$)
If sResp$ = "" Then Exit Sub
iInitSelStart=Selection.Start: iInitSelEnd=Selection.End 'for ensuing Finds
iNewPos = iInitSelStart 'our target - where we will go when done
iNewPosLen = iInitSelEnd - iInitSelStart + 1
iCommaPos = 1: iSavPos = 1: bFound = False
While iCommaPos > 0 'always do at least one Find
'aha! The next line is the key to working properly.
'Remove it, and you get bad results in Word97. It would be great
'if someone could explain what happens when next line is commented
Selection.Start = iInitSelStart + 1: Selection.End = iInitSelStart + 1
'this or next Instr will decide the Wending
iCommaPos=InStr(iSavPos,sResp$,",")
If iSavPos<=Len(sResp$) Then sstr$=Mid$(sResp$,iSavPos)'provisional
If iCommaPos>0 Then 'to restate sStr$(if iCommaPos reveals DELIMITING comma)
If iCommaPos=1 Then bLoopForBkSlash=False Else bLoopForBkSlash=True
'GRR! No exit while. Can't "while Mid$"; iCommaPos may be 1
While bLoopForBkSlash
If Not Mid$(sResp$,iCommaPos-1,1)="\" Then bLoopForBkSlash=False
If bLoopForBkSlash Then 'i.e., the Mid$ found it
sResp$=Left$(sResp$,iCommaPos-2)+Mid$(sResp$,iCommaPos)
sstr$=Mid$(sResp$,iSavPos) 'again provisionally in case no commas
iCommaPos=InStr(iCommaPos,sResp$, ",") 'not (iCommaPos+1,
If iCommaPos = 0 Then bLoopForBkSlash = False
End If
Wend
If iCommaPos>0 Then sstr$=Mid$(sResp$,iSavPos,iCommaPos-iSavPos)
iSavPos = iCommaPos + 1
End If
If sstr$ <> "" Then
With Selection.Find
.Forward = True: .Wrap = wdFindStop: .Execute FindText:=sstr$
End With
End If
' MsgBox "<" + sStr$ + "> " + Str$(Selection.Find.Found)
'Stop
If Selection.Find.Found Then
bFound = True: iTrialPos = Selection.Start
If iNewPos = iInitSelStart Then 'trial's our very first hit - save it
iNewPos = iTrialPos: iNewPosLen = Len(sstr$)
Else 'else iNewPos DID have prior value; update if sooner in file
If iTrialPos<iNewPos Then iNewPos=iTrialPos: iNewPosLen=Len(sstr$)
End If
End If
Selection.Start = iInitSelStart: Selection.End = iInitSelEnd
Wend
If bFound Then Selection.Start=iNewPos: _
Selection.End=iNewPos+iNewPosLen _
Else MsgBox "Solly, no, Cholly"
End Sub
My VBA skills are weakest with Word, so I'll be grateful if true experts will proceed to lock and load at it. There's some narrative along those lines in the comments in the code.
I have removed tons of whitespace below to shorten wide lines, which looks severe as I preview this. I have put in needless line continuation underscores for this too. It was fine in the VBA window :( (though my tabsize is 2)
'This is a nonwrapping FORWARD search for "OR" arguments, comma-separated.
'It IGNORES current selection (except to change it when the search succeeds).
'Notice that it uses the static variable sResp$, defined atop this module
'Dim sResp$
'Usage e.g.:
'Type(without the quotes)"a,e,i,o,u" in InputBox & it goes to next vowel
'Also beware that while debugging, CODE WINDOW is operated on, not
'the "active document"? - I'd sure love to know how to get around that
Sub CompoundFind() 'you're nuts not to keyboard accel. these two...
CompoundFindCommonCode (True)
End Sub
Sub CompoundFindNext()
CompoundFindCommonCode (False)
End Sub
Sub CompoundFindCommonCode(bPrompt As Boolean)
Dim iInitSelStart&, iInitSelEnd&, iCommaPos&, _
iSavPos&, iTrialPos&, iNewPos&, iNewPosLen&
Dim sstr$, bFound As Boolean, bLoopForBkSlash As Boolean
If bPrompt Then _
sResp$=InputBox$("Type multiple ' Or ' Find items, comma separated " _
& Chr(10) & "( Use \, for actual comma) ", "MultiFind", sResp$)
If sResp$ = "" Then Exit Sub
iInitSelStart=Selection.Start: iInitSelEnd=Selection.End 'for ensuing Finds
iNewPos = iInitSelStart 'our target - where we will go when done
iNewPosLen = iInitSelEnd - iInitSelStart + 1
iCommaPos = 1: iSavPos = 1: bFound = False
While iCommaPos > 0 'always do at least one Find
'aha! The next line is the key to working properly.
'Remove it, and you get bad results in Word97. It would be great
'if someone could explain what happens when next line is commented
Selection.Start = iInitSelStart + 1: Selection.End = iInitSelStart + 1
'this or next Instr will decide the Wending
iCommaPos=InStr(iSavPos,sResp$,",")
If iSavPos<=Len(sResp$) Then sstr$=Mid$(sResp$,iSavPos)'provisional
If iCommaPos>0 Then 'to restate sStr$(if iCommaPos reveals DELIMITING comma)
If iCommaPos=1 Then bLoopForBkSlash=False Else bLoopForBkSlash=True
'GRR! No exit while. Can't "while Mid$"; iCommaPos may be 1
While bLoopForBkSlash
If Not Mid$(sResp$,iCommaPos-1,1)="\" Then bLoopForBkSlash=False
If bLoopForBkSlash Then 'i.e., the Mid$ found it
sResp$=Left$(sResp$,iCommaPos-2)+Mid$(sResp$,iCommaPos)
sstr$=Mid$(sResp$,iSavPos) 'again provisionally in case no commas
iCommaPos=InStr(iCommaPos,sResp$, ",") 'not (iCommaPos+1,
If iCommaPos = 0 Then bLoopForBkSlash = False
End If
Wend
If iCommaPos>0 Then sstr$=Mid$(sResp$,iSavPos,iCommaPos-iSavPos)
iSavPos = iCommaPos + 1
End If
If sstr$ <> "" Then
With Selection.Find
.Forward = True: .Wrap = wdFindStop: .Execute FindText:=sstr$
End With
End If
' MsgBox "<" + sStr$ + "> " + Str$(Selection.Find.Found)
'Stop
If Selection.Find.Found Then
bFound = True: iTrialPos = Selection.Start
If iNewPos = iInitSelStart Then 'trial's our very first hit - save it
iNewPos = iTrialPos: iNewPosLen = Len(sstr$)
Else 'else iNewPos DID have prior value; update if sooner in file
If iTrialPos<iNewPos Then iNewPos=iTrialPos: iNewPosLen=Len(sstr$)
End If
End If
Selection.Start = iInitSelStart: Selection.End = iInitSelEnd
Wend
If bFound Then Selection.Start=iNewPos: _
Selection.End=iNewPos+iNewPosLen _
Else MsgBox "Solly, no, Cholly"
End Sub