Code For Review

[Greg]

The other day I noticed that Find ^13{2,} and Replace with ^p failed to
remove empty paragraphs located between tables. Dave Rado in his
article
http://word.mvps.org/FAQs/MacrosVBA/DeleteEmptyParas.htm
implies the above find and replace pattern will remove all empty PMs
except the emtpy PM immediately preceeeding and following a table. I
have modified a macro that Dave posted in that article for removing
"all" empty PMs. The code is posted below for review and comment.

Sub RemoveEmptyPMs()
Dim oRng As Word.Range
Dim oTable As Table
Dim oCell As Cell
Dim Counter As Integer
Dim MyRange As Range
Dim emptyPara As Boolean
Dim EPFirstAndLast As Range

Set oRng = ActiveDocument.Content
'Remove empty PMs general
With oRng.Find
.Text = "^13{2,}"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
For Each oTable In oRng.Tables
#If VBA6 Then
'For Word 2000 and higher for speed
oTable.AllowAutoFit = False
#End If
'Remove empty PMs in table cells
Set oCell = oTable.Range.Cells(1)
For Counter = 1 To oTable.Range.Cells.Count
If Len(oCell.Range.Text) > 2 And _
oCell.Range.Characters(1).Text = vbCr Then
oCell.Range.Characters(1).Delete
End If
If Len(oCell.Range.Text) > 2 And _
Asc(Right$(oCell.Range.Text, 3)) = 13 Then
Set MyRange = oCell.Range
MyRange.MoveEnd Unit:=wdCharacter, Count:=-1
MyRange.Characters.Last.Delete
End If
Set oCell = oCell.Next
Next Counter
'Remove empty PMs immediate before, after, and between tables
Set MyRange = oTable.Range
MyRange.Collapse wdCollapseEnd
If MyRange.Paragraphs(1).Range.Text = vbCr Then
MyRange.Collapse wdCollapseEnd
MyRange.Move wdParagraph, 1
If MyRange.Information(wdWithInTable) Then
'Do nothing. Issue will be resolve while processing next table.
Else
MyRange.Move wdParagraph, -1
MyRange.Paragraphs(1).Range.Delete
End If
End If
Set MyRange = oTable.Range
Do
MyRange.Collapse wdCollapseStart
MyRange.Move wdParagraph, -1
If MyRange.Paragraphs(1).Range.Text = vbCr Then
MyRange.Collapse wdCollapseStart
If MyRange.Start = oRng.Start Then
MyRange.Paragraphs(1).Range.Delete
Else
MyRange.Move wdParagraph, -1
If MyRange.Information(wdWithInTable) Then
If MsgBox("You have two tables separatated" _
& " by a single empty paragraph" _
& " mark. Do you want to delete" _
& " the empty paragraph and merge" _
& " the two tables?", vbYesNo) = vbYes Then
MyRange.Move wdParagraph, 1
emptyPara = True
MyRange.Paragraphs(1).Range.Delete
End If
Else
MyRange.Move wdParagraph, 1
emptyPara = True
MyRange.Paragraphs(1).Range.Delete
End If
End If
Else
emptyPara = False
End If
Loop While emptyPara = True
Next oTable
'Remove first and last empty PM
If oRng.Paragraphs.Count > 1 Then
Set EPFirstAndLast = oRng.Paragraphs.First.Range
If EPFirstAndLast.Text = vbCr Then EPFirstAndLast.Delete
Set EPFirstAndLast = oRng.Paragraphs.Last.Range
If EPFirstAndLast.Text = vbCr Then EPFirstAndLast.Delete
End If
End Sub

 

[Helmut Weber]

Hi Greg,

perfect!

Almost ;-)

as I think you like brain teasers,

from a sequence of empty paragraphs in a cell
in a nested table one empty paragraph seems to resist.

Greetings from Bavaria, Germany

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

 

[Helmut Weber]

....
needn't be a sequence (or sequel ?)
It's an empty paragraph at the beginning
of a cell in a nested table, that doesn't like
to be removed.

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98

 

[Greg]

Helmut,

I think this might do:

'Remove empty PMs in table cells
Set oCell = oTable.Range.Cells(1)
For Counter = 1 To oTable.Range.Cells.Count
Do While Len(oCell.Range.Text) > 2 And _
oCell.Range.Characters(1).Text = vbCr
oCell.Range.Characters(1).Delete
Loop
If Len(oCell.Range.Text) > 2 And _
Asc(Right$(oCell.Range.Text, 3)) = 13 Then
Set MyRange = oCell.Range
MyRange.MoveEnd Unit:=wdCharacter, Count:=-1
MyRange.Characters.Last.Delete
End If
Set oCell = oCell.Next
Next Counter

 

[Helmut Weber]

Hi Greg,

no change. I wonder, whether there is a way,
to process cells in nested tables at all.

However,

Dim p As Paragraph
For Each p In ActiveDocument.Paragraphs
If p.Range.Text = Chr(13) Then
p.Range.Delete
End If
Next

though probably slow, plus a function
betweentables() as boolean
or the like might work as well,
and would be kind of simpler.

Got to be going now for playing chess.
See you later.

Greetings from Bavaria, Germany

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

 

[Greg Maxey]

Helmut,

Using the code I have available at in a template here I can get good results
if I use the option to remove empty paragraphs, selected the text, and the
cursor is in the nested table:

http://gregmaxey.mvps.org/Clean_Up_Text.htm

I have not been able to figure out how to drill down into a nexted table
though.

 

[Jean-Guy Marcil]

Greg Maxey was telling us:
Greg Maxey nous racontait que :

Helmut,

Using the code I have available at in a template here I can get good
results if I use the option to remove empty paragraphs, selected the
text, and the cursor is in the nested table:

http://gregmaxey.mvps.org/Clean_Up_Text.htm

I have not been able to figure out how to drill down into a nexted
table though.

Here is a little something to get you going... I am not sure how you would
have to modify it to fit within your code... I guess it would be easier to
have it in a separate Sub that you would call form you main Sub, this way
you can check for multiple nested levels..

Dim aTable As Table
Dim aCell As Cell
Dim nestedTables As Tables
Dim i As Long
Dim j As Long

With ActiveDocument
For i = 1 To .Tables.Count
Set aTable = .Tables(i)
Set nestedTables = aTable.Range.TopLevelTables
If nestedTables.Count > 0 Then
For j = 1 To nestedTables.Count
nestedTables(j).Range.Cells.Shading.BackgroundPatternColor =
wdColorBlue
Next
End If
Next
End With

--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org

 

[Greg]

JGM,

Yes I see how your code works, but I can't get my head around how to:

1)For Each Table
2)For Each Cell
3)For Each Nested Table
4)For Each Cell
5)For Each Nested Table
.....
i.e., Evaluate and process each cell in the deepest nested table (i.e.,
the center Chinese egg) .