Document Cleanup Automation

S

Steven Drenker

Hi all...I frequently grab articles on the web and like to clean them up
into a standard format. I wrote the following macro that does a whole lot
of clean up as defined in the two string arrays vFindText and vReplText
(They used to be Variant arrays -- the "v" prefix stuck). I am having a
couple of problems. It still hangs occasionally when there are two or more
returns. I solved this problem with usergroup help a couple years ago, but
can't find the solution.

I want to make apply the "Heading 1" style to the first paragraph and apply
the "Heading 3" style to any paragraph that fits on one line. I attempted
this at the end, but with so-so results. Any ideas how to address these two
problems?

Steve Drenker


' This macro removes extra spaces, spaces before commas, spaces after

' open paren and before close paren, spaces before paragraph returns,

' spaces after paragraph returns and multiple paragraph returns.

' Adapted 2/7/03 from Jonathon West, Word MVP, http://www.multilinker.com

Const ArrayUBound = 19

Dim vFindText(ArrayUBound) As String

Dim vReplText(ArrayUBound) As String

Dim i As Long

Dim MyRange As Range

Dim objPara As Paragraph





' NOTE: Put the "^p^p" last after the previous cleanup of paragraph returns

' has been completed (i.e., spaces before and after other para returns)

vFindText(0) = "( "

vFindText(1) = " )"

vFindText(2) = " ,"

vFindText(3) = " ."

vFindText(4) = " " ' Two spaces

vFindText(5) = " ^p" ' Space in front of paragraph return

vFindText(6) = "^p "

vFindText(7) = "--" ' En-dash

vFindText(8) = ",,"

vFindText(9) = "..." ' Ellipsis

vFindText(10) = ".." ' Double periods (after completing ellipsis
conversion)

vFindText(11) = "Ö " ' Space after ellipsis

vFindText(12) = "``" ' Left double quotes

vFindText(13) = "`" ' Left single quote

vFindText(14) = "''"

vFindText(15) = " ^= "

vFindText(16) = " ^="

vFindText(17) = "^= "

vFindText(18) = "|"

vFindText(19) = "^p^p"



vReplText(0) = "("

vReplText(1) = ")"

vReplText(2) = ","

vReplText(3) = "."

vReplText(4) = " "

vReplText(5) = "^p"

vReplText(6) = "^p"

vReplText(7) = "^="

vReplText(8) = ","

vReplText(9) = "Ö"

vReplText(10) = "."

vReplText(11) = "Ö"

vReplText(12) = """"

vReplText(13) = "'"

vReplText(14) = """"

vReplText(15) = "|"

vReplText(16) = "|"

vReplText(17) = "|"

vReplText(18) = "^s^=^s"

vReplText(19) = "^p"



' Alternative approach to initializing arrays. This gets very hard to read

' with more than 4 or 5 elements because you can't match the Find string

' to the Replace string.

' Dim vFindText As Variant

' Dim vReplText As Variant

' vFindText = Array("( ", " )", " ,", " .", " ", " ^p", "^p ", "^p^p", "
", "'", """")

' vReplText = Array("(", ")", ",", ".", " ", "^p", "^p", "^p", " ", "'",
"""")



With ActiveDocument.Content.Find

.ClearFormatting

For i = 0 To UBound(vFindText)

Selection.HomeKey Unit:=wdStory



Debug.Print i & " Find: " & vFindText(i)

Debug.Print i & " Replace: " & vReplText(i) & vbCrLf



If i = UBound(vFindText) Then

' Find & Replace won't delete the first or last paragraph returns

' in a document if they are empty. The lines in this If-Then block

' execute after completing all other cleanup except multiple CrLf

' It removes multiple returns at the beginning and the end of the

' document. This avoids the last cleanup code (^p^p --> ^p) going

' into an infinite loop if there is a double return at the end of

' the document.



Set MyRange = ActiveDocument.Paragraphs(1).Range

Do While MyRange.Text = vbCr

MyRange.Delete

Set MyRange = ActiveDocument.Paragraphs(1).Range

Loop



Set MyRange = ActiveDocument.Paragraphs.Last.Range

Do While MyRange.Text = vbCr

MyRange.Delete

Set MyRange = ActiveDocument.Paragraphs.Last.Range

Loop

End If




' Do all the other conversions
Do While .Execute(FindText:=vFindText(i), _

Forward:=True, _

Format:=True) = True

.Execute FindText:=vFindText(i), _

Forward:=True, _

Format:=True, _

ReplaceWith:=vReplText(i), _

Replace:=wdReplaceAll

Loop

Next i



' Convert straight quotes to curly quotes. Can't do this with the Do While /
Loop

' construct above because .Execute will always find both straight AND curly
quotes.

' Therefore need to do the .Execute on a single-pass.



.Execute FindText:="'", _

Forward:=True, _

Format:=True, _

ReplaceWith:="'", _

Replace:=wdReplaceAll



.Execute FindText:="""", _

Forward:=True, _

Format:=True, _

ReplaceWith:="""", _

Replace:=wdReplaceAll



End With



' Now format the document

Selection.WholeStory

Selection.Style = ActiveDocument.Styles("Normal")

ActiveDocument.Styles("Normal").ParagraphFormat.SpaceBefore = 12



For Each objPara In ActiveDocument.Paragraphs

If objPara.Range.Characters.Count < 80 Then

objPara.Style = ActiveDocument.Styles("Heading 3")

End If

Next objPara



Selection.HomeKey Unit:=wdStory

Selection.Style = ActiveDocument.Styles("Heading 1")



' Selection.Range.Paragraphs(1) = ActiveDocument.Styles("Heading 1")

End Sub



Sub CleanUp()

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Execute FindText:=" ^p", _

Forward:=True, _

Format:=True, _

ReplaceWith:="^p", _

Replace:=wdReplaceAll



.Execute FindText:="^p ", _

Forward:=True, _

Format:=True, _

ReplaceWith:="^p", _

Replace:=wdReplaceAll



.Execute FindText:="^p^p", _

Forward:=True, _

Format:=True, _

ReplaceWith:="|", _

Replace:=wdReplaceAll



.Execute FindText:="^p", _

Forward:=True, _

Format:=True, _

ReplaceWith:=" ", _

Replace:=wdReplaceAll



.Execute FindText:="|", _

Forward:=True, _

Format:=True, _

ReplaceWith:="^p", _

Replace:=wdReplaceAll

End With



Selection.Style = ActiveDocument.Styles("Normal")

Selection.Font.Reset

ActiveDocument.Styles("Normal").ParagraphFormat.SpaceBefore = 12

End Sub



Sub CleanUpMultipleReturns()

' Source:
http://groups.google.com/groups?hl=en&lr=&ie=UTF-8&oe=UTF-8&threadm=#clWyR
wzCHA.2868%40TK2MSFTNGP12&rnum=26&prev=/groups%3Fq%3Dsearch%2Breplace%2Bgrou
p:microsoft.public.word.vba.general%26start%3D20%26hl%3Den%26lr%3D%26ie%3DUT
F-8%26oe%3DUTF-8%26group%3Dmicrosoft.public.word.vba.general%26selm%3D%2523c
lWyRwzCHA.2868%2540TK2MSFTNGP12%26rnum%3D26



' This macro strips hard returns from end of every line and restores

' a single hard return where multiple returns previously existed.

Const ArrayUBound = 5

Dim vFindText(ArrayUBound) As String

Dim vReplText(ArrayUBound) As String

Dim i As Long

Dim MyRange As Range



' NOTE: Put the "^p^p" last after the previous cleanup of paragraph returns

' has been completed (i.e., spaces before and after other para returns)

vFindText(0) = " ^p" ' Space in front of paragraph return

vFindText(1) = "^p " ' Space after paragraph return

vFindText(2) = "^p^p" ' Convert double paragraph returns to single
pipe character

vFindText(3) = "^p" ' Convert all remaining paragraph returns to
spaces

vFindText(4) = "||"

vFindText(5) = "|" ' Convert remaining single pipe characters back
to single paragraph returns



vReplText(0) = "^p"

vReplText(1) = "^p"

vReplText(2) = "|" ' Mark any double paragraph returns with pipe
character

vReplText(3) = " "

vReplText(4) = "|"

vReplText(5) = "^p"





' Alternative approach to initializing arrays. This gets very hard to read

' with more than 4 or 5 elements because you can't match the Find string

' to the Replace string.

' Dim vFindText As Variant

' Dim vReplText As Variant

' vFindText = Array("( ", " )", " ,", " .", " ", " ^p", "^p ", "^p^p", "
", "'", """")

' vReplText = Array("(", ")", ",", ".", " ", "^p", "^p", "^p", " ", "'",
"""")



With ActiveDocument.Content.Find

.ClearFormatting

For i = 0 To UBound(vFindText)

Selection.HomeKey Unit:=wdStory



Debug.Print i & " Find: " & vFindText(i)

Debug.Print i & " Replace: " & vReplText(i) & vbCrLf



' Find & Replace won't delete the first or last paragraph
returns

' in a document if they are empty. This If-Then block executes
after

' spaces have been removed in front of and after paragraph
returns.

' It removes multiple returns at the beginning and the end of
the

' document. This avoids going into an infinite loop if there is
a

' double return at the end of the document.

If vFindText(i) <> "^p^p" Then

Set MyRange = ActiveDocument.Paragraphs(1).Range

Do While MyRange.Text = vbCr

MyRange.Delete

Set MyRange = ActiveDocument.Paragraphs(1).Range

Loop



Set MyRange = ActiveDocument.Paragraphs.Last.Range

Do While MyRange.Text = vbCr

MyRange.Delete

Set MyRange = ActiveDocument.Paragraphs.Last.Range

Loop

End If



If vFindText(i) <> "^p" Then

Do While .Execute(FindText:=vFindText(i), _

Forward:=True, _

Format:=True) = True

.Execute FindText:=vFindText(i), _

Forward:=True, _

Format:=True, _

ReplaceWith:=vReplText(i), _

Replace:=wdReplaceAll

Loop

Else

' Don't want a Do While / Loop when searching for paragraph
returns

' because it will infinitely loop at last paragraph return
because

' it never gets converted to a space

.Execute FindText:=vFindText(i), _

Forward:=True, _

Format:=True, _

ReplaceWith:=vReplText(i), _

Replace:=wdReplaceAll

End If

Next i

End With



Selection.WholeStory

Selection.Style = ActiveDocument.Styles("Normal")

ActiveDocument.Styles("Normal").ParagraphFormat.SpaceBefore = 12

End Sub



Sub SearchReplace()

' Detect when Word is trapped with a partial wildcard match

' at the very end of a document



' Article contributed by Bill Coan

' Dim SearchString(4) As String



' SearchString(0) = "\<\<"

' SearchString(1) = "\<[!>]@\<"

' SearchString(2) = "\>\>"

' SearchString(3) = "\>[!<]@\>"



Dim SearchFor() As String

Dim ReplaceWith() As String

'SearchFor() = (" ^p", " .")



SearchString(1) = "^p"



For i = 0 To 3

Selection.HomeKey Unit:=wdStory



'call subroutine that clears settings from find dialog

Call ClearFindAndReplaceParameters



With Selection.Find

.Text = SearchString(i)

.Replacement.Text = ""

.Forward = True

.Wrap = wdFindStop

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = True

.MatchSoundsLike = False

.MatchAllWordForms = v

End With



Do While Selection.Find.Execute()

'here's where we detect the fact that

'Word got lost at the end of the doc

If Selection.End = 0 Then Exit Do

'insert code here to act on found text

Selection.Collapse wdCollapseEnd

Loop



Next i

End Sub



Sub ClearFindAndReplaceParameters()

' Clear settings from Find and Replace dialog to prevent

' unexpected results from future Find or Replace operations



' Article contributed by Bill Coan



' To prevent the user from having to change the settings in the

' Find and Replace dialog after running your macros, make sure you

' call the following procedure after doing any Find and Replace

' operations in VBA.



With Selection.Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = ""

.Replacement.Text = ""

.Forward = True

.Wrap = wdFindStop

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With



End Sub



Sub Replace_line_breaks_with_para_returns()

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = "^l"

.Replacement.Text = "^p"

.Forward = True

.Wrap = wdFindStop

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

Selection.Find.Execute Replace:=wdReplaceAll

End Sub
 
D

Doug Robbins - Word MVP

Hi Stephen,

I haven't attempted to wade through all of your code, but if the issue now
is to apply the Heading 1 style to the first paragraph and the Heading 3
style to any paragraph that contains only one line of text, then the
following will do that:

Dim apara As Range, i As Integer
ActiveDocument.Paragraphs(1).Style = "Heading 1"
For i = 2 To ActiveDocument.Paragraphs.Count
Set apara = ActiveDocument.Paragraphs(i).Range
If apara.ComputeStatistics(Statistic:=wdStatisticLines) = 1 Then
apara.Style = "Heading 3"
End If
Next i

--
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.

Hope this helps
Doug Robbins - Word MVP
Steven Drenker said:
Hi all...I frequently grab articles on the web and like to clean them up
into a standard format. I wrote the following macro that does a whole lot
of clean up as defined in the two string arrays vFindText and vReplText
(They used to be Variant arrays -- the "v" prefix stuck). I am having a
couple of problems. It still hangs occasionally when there are two or more
returns. I solved this problem with usergroup help a couple years ago, but
can't find the solution.

I want to make apply the "Heading 1" style to the first paragraph and apply
the "Heading 3" style to any paragraph that fits on one line. I attempted
this at the end, but with so-so results. Any ideas how to address these two
problems?

Steve Drenker


' This macro removes extra spaces, spaces before commas, spaces after

' open paren and before close paren, spaces before paragraph returns,

' spaces after paragraph returns and multiple paragraph returns.

' Adapted 2/7/03 from Jonathon West, Word MVP, http://www.multilinker.com

Const ArrayUBound = 19

Dim vFindText(ArrayUBound) As String

Dim vReplText(ArrayUBound) As String

Dim i As Long

Dim MyRange As Range

Dim objPara As Paragraph





' NOTE: Put the "^p^p" last after the previous cleanup of paragraph returns

' has been completed (i.e., spaces before and after other para returns)

vFindText(0) = "( "

vFindText(1) = " )"

vFindText(2) = " ,"

vFindText(3) = " ."

vFindText(4) = " " ' Two spaces

vFindText(5) = " ^p" ' Space in front of paragraph return

vFindText(6) = "^p "

vFindText(7) = "--" ' En-dash

vFindText(8) = ",,"

vFindText(9) = "..." ' Ellipsis

vFindText(10) = ".." ' Double periods (after completing ellipsis
conversion)

vFindText(11) = "Ö " ' Space after ellipsis

vFindText(12) = "``" ' Left double quotes

vFindText(13) = "`" ' Left single quote

vFindText(14) = "''"

vFindText(15) = " ^= "

vFindText(16) = " ^="

vFindText(17) = "^= "

vFindText(18) = "|"

vFindText(19) = "^p^p"



vReplText(0) = "("

vReplText(1) = ")"

vReplText(2) = ","

vReplText(3) = "."

vReplText(4) = " "

vReplText(5) = "^p"

vReplText(6) = "^p"

vReplText(7) = "^="

vReplText(8) = ","

vReplText(9) = "Ö"

vReplText(10) = "."

vReplText(11) = "Ö"

vReplText(12) = """"

vReplText(13) = "'"

vReplText(14) = """"

vReplText(15) = "|"

vReplText(16) = "|"

vReplText(17) = "|"

vReplText(18) = "^s^=^s"

vReplText(19) = "^p"



' Alternative approach to initializing arrays. This gets very hard to read

' with more than 4 or 5 elements because you can't match the Find string

' to the Replace string.

' Dim vFindText As Variant

' Dim vReplText As Variant

' vFindText = Array("( ", " )", " ,", " .", " ", " ^p", "^p ", "^p^p", "
", "'", """")

' vReplText = Array("(", ")", ",", ".", " ", "^p", "^p", "^p", " ", "'",
"""")



With ActiveDocument.Content.Find

.ClearFormatting

For i = 0 To UBound(vFindText)

Selection.HomeKey Unit:=wdStory



Debug.Print i & " Find: " & vFindText(i)

Debug.Print i & " Replace: " & vReplText(i) & vbCrLf



If i = UBound(vFindText) Then

' Find & Replace won't delete the first or last paragraph returns

' in a document if they are empty. The lines in this If-Then block

' execute after completing all other cleanup except multiple CrLf

' It removes multiple returns at the beginning and the end of the

' document. This avoids the last cleanup code (^p^p --> ^p) going

' into an infinite loop if there is a double return at the end of

' the document.



Set MyRange = ActiveDocument.Paragraphs(1).Range

Do While MyRange.Text = vbCr

MyRange.Delete

Set MyRange = ActiveDocument.Paragraphs(1).Range

Loop



Set MyRange = ActiveDocument.Paragraphs.Last.Range

Do While MyRange.Text = vbCr

MyRange.Delete

Set MyRange = ActiveDocument.Paragraphs.Last.Range

Loop

End If




' Do all the other conversions
Do While .Execute(FindText:=vFindText(i), _

Forward:=True, _

Format:=True) = True

.Execute FindText:=vFindText(i), _

Forward:=True, _

Format:=True, _

ReplaceWith:=vReplText(i), _

Replace:=wdReplaceAll

Loop

Next i



' Convert straight quotes to curly quotes. Can't do this with the Do While /
Loop

' construct above because .Execute will always find both straight AND curly
quotes.

' Therefore need to do the .Execute on a single-pass.



.Execute FindText:="'", _

Forward:=True, _

Format:=True, _

ReplaceWith:="'", _

Replace:=wdReplaceAll



.Execute FindText:="""", _

Forward:=True, _

Format:=True, _

ReplaceWith:="""", _

Replace:=wdReplaceAll



End With



' Now format the document

Selection.WholeStory

Selection.Style = ActiveDocument.Styles("Normal")

ActiveDocument.Styles("Normal").ParagraphFormat.SpaceBefore = 12



For Each objPara In ActiveDocument.Paragraphs

If objPara.Range.Characters.Count < 80 Then

objPara.Style = ActiveDocument.Styles("Heading 3")

End If

Next objPara



Selection.HomeKey Unit:=wdStory

Selection.Style = ActiveDocument.Styles("Heading 1")



' Selection.Range.Paragraphs(1) = ActiveDocument.Styles("Heading 1")

End Sub



Sub CleanUp()

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Execute FindText:=" ^p", _

Forward:=True, _

Format:=True, _

ReplaceWith:="^p", _

Replace:=wdReplaceAll



.Execute FindText:="^p ", _

Forward:=True, _

Format:=True, _

ReplaceWith:="^p", _

Replace:=wdReplaceAll



.Execute FindText:="^p^p", _

Forward:=True, _

Format:=True, _

ReplaceWith:="|", _

Replace:=wdReplaceAll



.Execute FindText:="^p", _

Forward:=True, _

Format:=True, _

ReplaceWith:=" ", _

Replace:=wdReplaceAll



.Execute FindText:="|", _

Forward:=True, _

Format:=True, _

ReplaceWith:="^p", _

Replace:=wdReplaceAll

End With



Selection.Style = ActiveDocument.Styles("Normal")

Selection.Font.Reset

ActiveDocument.Styles("Normal").ParagraphFormat.SpaceBefore = 12

End Sub



Sub CleanUpMultipleReturns()

' Source:
http://groups.google.com/groups?hl=...p=microsoft.public.word.vba.general&selm=%23c
lWyRwzCHA.2868%2540TK2MSFTNGP12%26rnum%3D26



' This macro strips hard returns from end of every line and restores

' a single hard return where multiple returns previously existed.

Const ArrayUBound = 5

Dim vFindText(ArrayUBound) As String

Dim vReplText(ArrayUBound) As String

Dim i As Long

Dim MyRange As Range



' NOTE: Put the "^p^p" last after the previous cleanup of paragraph returns

' has been completed (i.e., spaces before and after other para returns)

vFindText(0) = " ^p" ' Space in front of paragraph return

vFindText(1) = "^p " ' Space after paragraph return

vFindText(2) = "^p^p" ' Convert double paragraph returns to single
pipe character

vFindText(3) = "^p" ' Convert all remaining paragraph returns to
spaces

vFindText(4) = "||"

vFindText(5) = "|" ' Convert remaining single pipe characters back
to single paragraph returns



vReplText(0) = "^p"

vReplText(1) = "^p"

vReplText(2) = "|" ' Mark any double paragraph returns with pipe
character

vReplText(3) = " "

vReplText(4) = "|"

vReplText(5) = "^p"





' Alternative approach to initializing arrays. This gets very hard to read

' with more than 4 or 5 elements because you can't match the Find string

' to the Replace string.

' Dim vFindText As Variant

' Dim vReplText As Variant

' vFindText = Array("( ", " )", " ,", " .", " ", " ^p", "^p ", "^p^p", "
", "'", """")

' vReplText = Array("(", ")", ",", ".", " ", "^p", "^p", "^p", " ", "'",
"""")



With ActiveDocument.Content.Find

.ClearFormatting

For i = 0 To UBound(vFindText)

Selection.HomeKey Unit:=wdStory



Debug.Print i & " Find: " & vFindText(i)

Debug.Print i & " Replace: " & vReplText(i) & vbCrLf



' Find & Replace won't delete the first or last paragraph
returns

' in a document if they are empty. This If-Then block executes
after

' spaces have been removed in front of and after paragraph
returns.

' It removes multiple returns at the beginning and the end of
the

' document. This avoids going into an infinite loop if there is
a

' double return at the end of the document.

If vFindText(i) <> "^p^p" Then

Set MyRange = ActiveDocument.Paragraphs(1).Range

Do While MyRange.Text = vbCr

MyRange.Delete

Set MyRange = ActiveDocument.Paragraphs(1).Range

Loop



Set MyRange = ActiveDocument.Paragraphs.Last.Range

Do While MyRange.Text = vbCr

MyRange.Delete

Set MyRange = ActiveDocument.Paragraphs.Last.Range

Loop

End If



If vFindText(i) <> "^p" Then

Do While .Execute(FindText:=vFindText(i), _

Forward:=True, _

Format:=True) = True

.Execute FindText:=vFindText(i), _

Forward:=True, _

Format:=True, _

ReplaceWith:=vReplText(i), _

Replace:=wdReplaceAll

Loop

Else

' Don't want a Do While / Loop when searching for paragraph
returns

' because it will infinitely loop at last paragraph return
because

' it never gets converted to a space

.Execute FindText:=vFindText(i), _

Forward:=True, _

Format:=True, _

ReplaceWith:=vReplText(i), _

Replace:=wdReplaceAll

End If

Next i

End With



Selection.WholeStory

Selection.Style = ActiveDocument.Styles("Normal")

ActiveDocument.Styles("Normal").ParagraphFormat.SpaceBefore = 12

End Sub



Sub SearchReplace()

' Detect when Word is trapped with a partial wildcard match

' at the very end of a document



' Article contributed by Bill Coan

' Dim SearchString(4) As String



' SearchString(0) = "\<\<"

' SearchString(1) = "\<[!>]@\<"

' SearchString(2) = "\>\>"

' SearchString(3) = "\>[!<]@\>"



Dim SearchFor() As String

Dim ReplaceWith() As String

'SearchFor() = (" ^p", " .")



SearchString(1) = "^p"



For i = 0 To 3

Selection.HomeKey Unit:=wdStory



'call subroutine that clears settings from find dialog

Call ClearFindAndReplaceParameters



With Selection.Find

.Text = SearchString(i)

.Replacement.Text = ""

.Forward = True

.Wrap = wdFindStop

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = True

.MatchSoundsLike = False

.MatchAllWordForms = v

End With



Do While Selection.Find.Execute()

'here's where we detect the fact that

'Word got lost at the end of the doc

If Selection.End = 0 Then Exit Do

'insert code here to act on found text

Selection.Collapse wdCollapseEnd

Loop



Next i

End Sub



Sub ClearFindAndReplaceParameters()

' Clear settings from Find and Replace dialog to prevent

' unexpected results from future Find or Replace operations



' Article contributed by Bill Coan



' To prevent the user from having to change the settings in the

' Find and Replace dialog after running your macros, make sure you

' call the following procedure after doing any Find and Replace

' operations in VBA.



With Selection.Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = ""

.Replacement.Text = ""

.Forward = True

.Wrap = wdFindStop

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With



End Sub



Sub Replace_line_breaks_with_para_returns()

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = "^l"

.Replacement.Text = "^p"

.Forward = True

.Wrap = wdFindStop

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

Selection.Find.Execute Replace:=wdReplaceAll

End Sub
 

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

Top