find&replace text throughout a document

N

Nicholas Lim

I am trying to programmatically replace text throughout a document using
string manipulation and complex logic, which may not easily be coded into the
single assignment statement: .Replacement.Text = "xxx"
which doesn't appear to allow multiple procedural string manipulations of
found text (unless I can hook a 'found' event handler which has the found
text in scope?).

First example
I'd like to correct speech recognition errors to change dialogue that starts
with an extra space and uncapitalised: " why?" into: "Why?" without using
ALLCAPS or any font-formatting, instead using UCase or programmatic changing
of the actual letters. Once I can understand how to do this example,
hopefully I can code other requirements. Many thanks!


Code example
The following code works but unfortunately issues the prompt "Word has
reached the end of the document. Do you want to continue searching from the
beginning?" ...which is not practical for contant use.


Sub Macro1()
ResetSearch
' Find any "X pattern
If Selection.Find.Execute("""^?", 0, 0, 0, 0, 0, 0, 1) = True Then
Do
'...and replace by "X
Selection.Text = UCase(Selection.Text)
Loop While Selection.Find.Execute("""^?", 0, 0) = True
End If
End Sub

I don't want to use Selection.Find.Execute Replace:=wdReplaceAll (with
..Wrap = wdFindContinue) because of the limitations of the single
..Replacement.Text = "xxx" assignment statement.

With my current code approach above, initially setting .Wrap =
wdFindContinue (in ResetSearch sub below) doesn't appear to work.
Used explicitly in the find calls, e.g. Selection.Find.Execute("""^?", 0, 0,
0, 0, 0, 0, 1), results in an infinite loop.


Public Sub ResetSearch()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
..ClearFormatting
..Replacement.ClearFormatting
..Text = ""
..Replacement.Text = ""
..Forward = True
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = False
..MatchSoundsLike = False
..MatchAllWordForms = False
..Execute
End With
End Sub


Many thanks for any help.
 
N

Nicholas Lim

Many thanks. Yes, I have tried this approach, using
Selection.Find.Execute Replace:=wdReplaceAll
and
With Selection.Find
.Text = """ ^?"
.Replacement.Text = """^&"
and
applying AllCaps
But the approach has two drawbacks:
1) There is font-level formatting applied all over the document
2) the .Replacement.Text assignment statement is so restrictive compared to
a series of clear VBA statements that can reference the selected text and use
UCase, Replace, Split etc
 
G

Graham Mayor

It is not easy to see why you want to complicate things when a simple
solution will suffice - unless you are not telling us the whole story?

You cannot use multiple formatting types in the replace string - the only
way to do that is to copy the pre-formatted string to the clipboard then
replace the text with the clipboard content ^c

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
 
D

Doug Robbins - Word MVP

Use:

Dim myrange As Range

Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(findText:=" why?", Forward:=True,
MatchWildcards:=False, _
MatchCase:=True, Wrap:=wdFindStop) = True
Set myrange = Selection.Range
With myrange
.Text = UCase(Mid(.Text, 2, 1)) & Mid(.Text, 3)
End With
Loop
End With


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP
 
F

fumei via OfficeKB.com

Sub SpaceCap()
Dim r As Range
Set r = ActiveDocument.Range
With r.Find
.ClearFormatting
Do While .Execute(FindText:=" why", Forward:=True) = True
r.Text = LTrim(r.Text)
r.Text = UCase(Left(r.Text, 1)) & _
Right(r.Text, Len(r.Text) - 1)
r.Collapse Direction:=wdCollapseEnd
Loop
End With
Set r = Nothing
End Sub

will take " why", and make it "Why", and will retain the individual format of
each.

You could amend it to take an entered search string, or you could amend it to
go through an array of words, like this:

Sub SpaceCap2()
Dim r As Range
Dim myWords()
Dim var

myWords = Array(" why", " who", " what", " where")
Set r = ActiveDocument.Range
For var = 0 To UBound(myWords)
With r.Find
.ClearFormatting
Do While .Execute(FindText:=myWords(var), Forward:=True) = True
r.Text = LTrim(r.Text)
r.Text = UCase(Left(r.Text, 1)) & _
Right(r.Text, Len(r.Text) - 1)
r.Collapse Direction:=wdCollapseEnd
Loop
End With
Set r = ActiveDocument.Range
Next
Set r = Nothing
End Sub

The code above would go through the document, changing all the " why" to
"Why" - again, retaining format - then resets the r variable to the whole
document,and then processes the next item in the array, " who". And so on.

I too have to wonder if there is something that is not being mentioned.
 
H

Helmut Weber

Hi Nicholas,

for that purpose avoid the selection.

"ResetSearch" is from former times,
when I didn't know about ranges.


Sub Test666b()
Dim rDcm As Range
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Text = " why"
.MatchCase = True
.Replacement.Text = "Why"
.Execute Replace:=wdReplaceAll
.Text = " what"
.MatchCase = True
.Replacement.Text = "What"
.Execute Replace:=wdReplaceAll
End With
End Sub


HTH



--

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP
 
N

Nicholas Lim

I'm a word VBA macro newbie and didn't know about ranges. Very elegant. Thank
you. Here's your solution generalized, with fix using QuoteDistinguisher to
avoid consequent infinite looping. My outstanding issue is summarized in the
first code comment, in order to avoid:
" why?" said fred.
becoming
"Why?"said fred.
- which is good except for the loss of space after closing quote.
Many thanks for your help.
N


Sub FixDialogue()
QuoteDistinguisher = "@@@"

'Ensure smart quotes, then change FixDialogue_RemoveLeadingSpace to
process only if opening quote char...???
FixDialogue_RemoveLeadingSpace
FixDialogue_ReplaceQuotesToDistinguish (QuoteDistinguisher)
FixDialogue_MakeInitialCapsFollowingQuote (QuoteDistinguisher)
End Sub
Sub FixDialogue_RemoveLeadingSpace()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = """ "
.Replacement.Text = """"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Sub FixDialogue_ReplaceQuotesToDistinguish(QuoteDistinguisher)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = """"
.Replacement.Text = QuoteDistinguisher & """"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Sub FixDialogue_MakeInitialCapsFollowingQuote(QuoteDistinguisher)
QDLen = Len(QuoteDistinguisher)
Dim myrange As Range
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Wrap = wdFindStop
Do While .Execute(findText:=QuoteDistinguisher & """^?", _
Forward:=True, _
MatchWildcards:=False, _
MatchCase:=True) = True
Set myrange = Selection.Range
With myrange
.Text = """" & UCase(Mid(.Text, 2 + QDLen, 1 + QDLen)) &
Mid(.Text, 3 + QDLen)
End With
Loop
End With
End Sub
 
D

Doug Robbins - Word MVP

I don't understand your code, but if the code I gave you is removing the
trailing space I would modify it as follows:

Set myrange = Selection.Range
With myrange
.End = . End - 1
.Text = UCase(Mid(.Text, 2, 1)) & Mid(.Text, 3)
End With


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP
 
N

Nicholas Lim

Thank you! Apologies, two more questions (!)
Do you have VBA code to find and replace all straight quotes with smart
quotes?
And do you know the chr() values for the smart open and smart closing quotes?
 
G

Greg Maxey

Nicholas,

Try:
Sub QuoteStyleToggle()
If Options.AutoFormatAsYouTypeReplaceQuotes = True Then
If MsgBox("SmartQuotes are on. Do you want switch to straight quotes?
", _
vbYesNo, "Quote Style Toggle") = vbYes Then
Options.AutoFormatAsYouTypeReplaceQuotes = False
If MsgBox("Do you want to replace existing Smartquotes" _
& " with straight quotes?", vbYesNo, "Reformat Quotes")
= vbYes Then
QuoteChangeFormat
Else: Exit Sub
End If
Else: Exit Sub
End If

Else
If MsgBox("Staight quotes are on. Do you want switch to SmartQuotes? ",
_
vbYesNo, "Quote Style Toggle") = vbYes Then
Options.AutoFormatAsYouTypeReplaceQuotes = True
If MsgBox("Do you want to replace existing straight quotes" _
& " with Smartquotes?", vbYesNo, "Reformat Quotes") =
vbYes Then
QuoteChangeFormat
Else: Exit Sub
End If
Else: Exit Sub
End If
End If
End Sub
Sub QuoteChangeFormat()
Dim rngStory As Word.Range
For Each rngStory In ActiveDocument.StoryRanges
Do
If rngStory.StoryLength >= 2 Then
With rngStory.Find
.Text = Chr$(34)
.Replacement.Text = Chr$(34)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.Execute Replace:=wdReplaceAll
.Text = Chr$(39)
.Replacement.Text = Chr$(39)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.Execute Replace:=wdReplaceAll
End With
End If
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
End Sub
 
N

Nicholas Lim

Thank you.
PS Recently, I remember reading the two different chr() values for the smart
open quote and smart closing quote. I can't find the reference now - do you
know what these chr() values are?
PPS could you tell me the find&replace values for:
find: all occasions where two spaces occur in a row
replace by: one space.
 
G

Graham Mayor

The smart quoted are chr(145) to (148)
The simplest way to change straight quotes to smart quotes is to autoformat
the document with this setting checked.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Change a great number of words in word files, with a macro as short as possible. 5
Loop until end 1
Word macro that can call cells out of Excel for a find and replace 0
Select Text to End of Footnote 9
Convert old wordbasic code into VBA that will run now 0
Prompt For Replace in Selection And More... 0
Trouble with Find and Replace vba routine 2
CleanUpPastedText() 1

Top