|
|
|
|
Fantastic! Thanks Greg!
"Greg Maxey" wrote:
PJ,
See:
http://word.mvps.org/FAQs/Formatting/CleanWebText.htm
I use this macro to CleanUp text:
Sub CleanUpText()
Dim EP As Paragraph
Dim Response1 As Long
Dim Response2 As Long
Dim Response3 As Long
Dim Response4 As String
Response3 = MsgBox("Do you want to remove leading spaces or characters?",
vbYesNo)
If Response3 = vbYes Then
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^l {1,}"
.Replacement.Text = "^l"
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "^l[\]{1,}"
.Replacement.Text = "^l"
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "^13[\]{1,}"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^13 {1,}"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "^l {1,}"
.Replacement.Text = "^l"
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Response4 = InputBox("Type in any additional leading character")
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = Response4
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End If
Response2 = MsgBox("Do you want to replace linebreaks with paragraph
fromatting?", vbYesNo)
If Response2 = vbYes Then
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^l{2,}"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^l"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
End If
Response1 = MsgBox("Do you want to delete empty paragraphs in this
document?", vbYesNo)
If Response1 = vbYes Then
For Each EP In ActiveDocument.Paragraphs
If Len(EP.Range.Text) = 1 Then EP.Range.Delete
Next EP
End If
End Sub
--
Greg Maxey/Word MVP
A Peer in Peer to Peer Support
PJ wrote:
I often need to import text files from other applications into Word.
Frequently these files have hard breaks at the end of each line. I'd
like an easy (macro, script, etc) way to remove the extra breaks so
the lines wrap naturally.
Thanks!
|