find&replace text throughout a document

Nicholas Lim · Guest

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.
--
NickL

Google · Sponsor

Doug Robbins - Word MVP · Guest

See the article "Finding and replacing characters using wildcards" at:

http://www.word.mvps.org/FAQs/General/UsingWildcards.htm

--
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

"Nicholas Lim" <NicholasLim@discussions.microsoft.com> wrote in message
news:6609834C-2C6E-46B9-B909-C1973DC261D6@microsoft.com...

Nicholas Lim · Guest

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

--
NickL

"Doug Robbins - Word MVP" wrote:

Nicholas Lim · Guest

Many thanks for your reply, but see my reply to Doug...
--
NickL

"Helmut Weber" wrote:

Graham Mayor · Guest

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

My web site www.gmayor.com
Word MVP web site http://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Nicholas Lim wrote:

Doug Robbins - Word MVP · Guest

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

"Nicholas Lim" <NicholasLim@discussions.microsoft.com> wrote in message
news:D0C0A136-2839-4E8E-9568-232152D79C18@microsoft.com...

fumei via OfficeKB.com · Guest

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.

--
Message posted via http://www.officekb.com

Helmut Weber · Guest

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

Nicholas Lim · Guest

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
--
NickL

"Doug Robbins - Word MVP" wrote:

Doug Robbins - Word MVP · Guest

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

"Nicholas Lim" <NicholasLim@discussions.microsoft.com> wrote in message
news:D004CCEE-EB62-44A8-A32F-875BE26616B8@microsoft.com...

Nicholas Lim · Guest

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?

--
NickL

"Doug Robbins - Word MVP" wrote:

Greg Maxey · Guest

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

--
Greg Maxey/Word MVP
See:
http://gregmaxey.mvps.org/word_tips.htm
For some helpful tips using Word.

Nicholas Lim wrote:

Nicholas Lim · Guest

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.
--
NickL

"Greg Maxey" wrote:

Graham Mayor · Guest

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

My web site www.gmayor.com
Word MVP web site http://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Nicholas Lim wrote: