View Single Post
  #3   Report Post  
Greg Maxey
 
Posts: n/a
Default

Fred,

See:
http://word.mvps.org/FAQs/Formatting/CleanWebText.htm


I use this macro to clean up web 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

Fred wrote:
In converting web pages to word docs I get a lot of empty paragraphs.
I'd like to delete them quickly. What is the best way?

I tried the "find" (^13){1,}, "replace with" \1 . That didn't work
for me.