find&replace text throughout a document

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Nicholas Lim - 18 Nov 2007 12:28 GMT

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.

Signature

NickL

Reply to this Message

Doug Robbins - Word MVP - 18 Nov 2007 19:29 GMT

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

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

Signature

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

>I am trying to programmatically replace text throughout a document using
> string manipulation and complex logic, which may not easily be coded into
[quoted text clipped - 61 lines]
>
> Many thanks for any help.

Reply to this Message

Nicholas Lim - 18 Nov 2007 22:18 GMT

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

Signature

NickL

> See the article "Finding and replacing characters using wildcards" at:
>
[quoted text clipped - 65 lines]
> >
> > Many thanks for any help.

Reply to this Message

Doug Robbins - Word MVP - 19 Nov 2007 06:08 GMT

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

Signature

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

> Many thanks. Yes, I have tried this approach, using
> Selection.Find.Execute Replace:=wdReplaceAll
[quoted text clipped - 87 lines]
>> >
>> > Many thanks for any help.

Reply to this Message

Nicholas Lim - 20 Nov 2007 15:27 GMT

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

Signature

NickL

> Use:
>
[quoted text clipped - 104 lines]
> >> >
> >> > Many thanks for any help.

Reply to this Message

Doug Robbins - Word MVP - 20 Nov 2007 19:39 GMT

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

Signature

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

> I'm a word VBA macro newbie and didn't know about ranges. Very elegant.
> Thank
[quoted text clipped - 190 lines]
>> >> >
>> >> > Many thanks for any help.

Reply to this Message

Nicholas Lim - 21 Nov 2007 00:09 GMT

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?

Signature

NickL

> I don't understand your code, but if the code I gave you is removing the
> trailing space I would modify it as follows:
[quoted text clipped - 199 lines]
> >> >> >
> >> >> > Many thanks for any help.

Reply to this Message

Greg Maxey - 21 Nov 2007 00:40 GMT

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

Signature

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

> Thank you! Apologies, two more questions (!)
> Do you have VBA code to find and replace all straight quotes with
[quoted text clipped - 237 lines]
>>>>>>> --
>>>>>>> NickL

Reply to this Message

Nicholas Lim - 21 Nov 2007 10:20 GMT

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.

Signature

NickL

> Nicholas,
>
[quoted text clipped - 267 lines]
> >>>>>>> wdFindContinue (in ResetSearch sub below) doesn't appear to
> >>>>>>> work. Used explicitly in the find calls, e.g.

Reply to this Message

Graham Mayor - 21 Nov 2007 12:05 GMT

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.

Signature

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

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

> Thank you.
> PS Recently, I remember reading the two different chr() values for
[quoted text clipped - 282 lines]
>>>>>>>>> wdFindContinue (in ResetSearch sub below) doesn't appear to
>>>>>>>>> work. Used explicitly in the find calls, e.g.

Reply to this Message

Helmut Weber - 18 Nov 2007 20:10 GMT

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

Reply to this Message

Nicholas Lim - 18 Nov 2007 22:28 GMT

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

Signature

NickL

> Hi Nicholas,
>
[quoted text clipped - 27 lines]
>
> Vista Small Business, Office XP

Reply to this Message

Graham Mayor - 19 Nov 2007 06:01 GMT

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

Signature

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

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

> Many thanks for your reply, but see my reply to Doug...
>
[quoted text clipped - 29 lines]
>>
>> Vista Small Business, Office XP

Reply to this Message

fumei - 19 Nov 2007 16:54 GMT

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.

Reply to this Message