Hi,
I've written a VBA script (for Microsoft Word 2000 on the PC) that
highlights the current paragraph, then breaks it up into sentences that are
separated by paragraph marks. Now the author can analyze the structure of
the writing, and move the sentences around.
The script adds double paragraph marks after "." "!" "?" and ";".
Afterwards, it also removes the new, unnecessary paragraph marks after
"Mr." "Ms." "Mrs." "a.m." and "p.m." However, it doesn't fix other
abbreviations.
I was wondering if someone can improve this macro.
Thanks.
Here's the script.
- - -
Sub Paragraph_Smasher()
'
' Paragraph_Smasher Macro breaks up a paragraph to help you see each
sentence
' Select the current Paragraph
Selection.StartOf Unit:=wdParagraph
Selection.MoveEnd Unit:=wdParagraph
' Put double paragraph marks after periods
Do
Selection.Find.ClearFormatting
' Use the Find object to search for text.
With Selection.Find
.Text = ". "
' Use the replacement object to replace text.
.Replacement.Text = "~.~^p^p"
.Execute Replace:=wdReplaceAll, Forward:=True
End With
' If no more occurrences, exit the loop.
If Selection.Find.Execute = False Then Exit Do
Loop
Do
Selection.Find.ClearFormatting
With Selection.Find
.Text = "~.~"
.Replacement.Text = "."
.Execute Replace:=wdReplaceAll, Forward:=True
End With
If Selection.Find.Execute = False Then Exit Do
Loop
' Remove paragraph marks after instances of "Mr." "Ms." Mrs."
Do
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Mr.^p^p"
.Replacement.Text = "Mr. "
.Execute Replace:=wdReplaceAll, Forward:=True
End With
If Selection.Find.Execute = False Then Exit Do
Loop
Do
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Ms.^p^p"
.Replacement.Text = "Ms. "
.Execute Replace:=wdReplaceAll, Forward:=True
End With
If Selection.Find.Execute = False Then Exit Do
Loop
Do
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Mrs.^p^p"
.Replacement.Text = "Mrs. "
.Execute Replace:=wdReplaceAll, Forward:=True
End With
If Selection.Find.Execute = False Then Exit Do
Loop
' Put instances of a.m. and p.m. back together
Do
Selection.Find.ClearFormatting
With Selection.Find
.Text = "a.^pm.^p"
.Replacement.Text = "a.m.^p"
.Execute Replace:=wdReplaceAll, Forward:=True
End With
If Selection.Find.Execute = False Then Exit Do
Loop
Do
Selection.Find.ClearFormatting
With Selection.Find
.Text = "p.^pm.^p"
.Replacement.Text = "p.m.^p"
.Execute Replace:=wdReplaceAll, Forward:=True
End With
If Selection.Find.Execute = False Then Exit Do
Loop
' Put paragraph marks after exclamation marks
Do
Selection.Find.ClearFormatting
With Selection.Find
.Text = "! "
.Replacement.Text = "~!~^p^p"
.Execute Replace:=wdReplaceAll, Forward:=True
End With
If Selection.Find.Execute = False Then Exit Do
Loop
Do
Selection.Find.ClearFormatting
With Selection.Find
.Text = "~!~"
.Replacement.Text = "!"
.Execute Replace:=wdReplaceAll, Forward:=True
End With
If Selection.Find.Execute = False Then Exit Do
Loop
' Put paragraph marks after question marks
Do
Selection.Find.ClearFormatting
With Selection.Find
.Text = "? "
.Replacement.Text = "~?~^p^p"
.Execute Replace:=wdReplaceAll, Forward:=True
End With
If Selection.Find.Execute = False Then Exit Do
Loop
Do
Selection.Find.ClearFormatting
With Selection.Find
.Text = "~?~"
.Replacement.Text = "?"
.Execute Replace:=wdReplaceAll, Forward:=True
End With
If Selection.Find.Execute = False Then Exit Do
Loop
' Put paragraph marks after semicolons
Do
Selection.Find.ClearFormatting
With Selection.Find
.Text = "; "
.Replacement.Text = "~;~^p^p"
.Execute Replace:=wdReplaceAll, Forward:=True
End With
If Selection.Find.Execute = False Then Exit Do
Loop
Do
Selection.Find.ClearFormatting
With Selection.Find
.Text = "~;~"
.Replacement.Text = ";"
.Execute Replace:=wdReplaceAll, Forward:=True
End With
If Selection.Find.Execute = False Then Exit Do
Loop
End Sub
--
Please delete "ANTI-SPAM" from email address daveg7777777@ANTI-SPAMyahoo.com
David Godinger: Go player, student of Mahatma Gandhi, the Buddha, and Dr. Martin King