I have some faulty paragraphs, which are causing my other macros to not work properly.

1. They are usually heading style 2, style 3
2. Empty (not sure)
3. before OR after table (not sure)
4. surrounded by dotted line
5. causes the heading and next table to merged together (not sure)

I tried to replace/removed those with the following macro:

Sub HeadingParaBug()
    Dim H As Range
    Set H = ActiveDocument.Range
    LS = Application.International(wdListSeparator)
    
    With H.Find
        
        .Text = "^p "
        .Replacement.Text = "^p"
        .Execute Replace:=wdReplaceAll
        
        .Text = " ^p"
        .Replacement.Text = "^p"
        .Execute Replace:=wdReplaceAll
        
        .Text = "^p ^p"
        .Replacement.Text = "^p^p"
        .Execute Replace:=wdReplaceAll
        
        .Text = "^13{2" & LS & "}"
        .Replacement.Text = "^p"
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
        .Text = ""
        .Style = wdStyleHeading2
        .MatchWildcards = False
    Do While .Execute
    If H.Text <> vbCr Then
        H.Collapse 0
        H.Select
        H.InsertParagraph
        H.Delete
    End If
        H.Collapse 0
    Loop
    End With
    
    Set H = ActiveDocument.Range
    
    With H.Find
        .Style = wdStyleHeading3
    Do While .Execute
    If H.Text <> vbCr Then
        H.Collapse 0
        H.Select
        H.InsertParagraph
        H.Delete
    End If
        H.Collapse 0
    Loop
    
    End With
    
End Sub

But somehow, it do not completely removed/replace the faulty paragraph marks. The above macro finds those paragraphs, add new and then remove it. which eventually removed the dotted line.

Can anybody explain this phenomena? what is the right ways to remove/replace those paragraphs. please download and see

CodePudding user response：

To unhide all document paragraphs, please try the next piece of code:

Sub UnHideParagraphs()
    Dim para As Paragraph
    For Each para In ActiveDocument.Paragraphs
        If para.Range.Font.Hidden Then
           para.Range.Font.Hidden = False
        End If
    Next para
End Sub

It should work even if only part of the paragraph range is hidden...

CodePudding user response：

Find/Replace won't delete duplicate paragraph breaks before a table, between tables, or after a table. Try:

Sub Demo()
Application.ScreenUpdating = False
Dim LS As String, Tbl As Table, bHid As Boolean
LS = Application.International(wdListSeparator)
bHid = ActiveWindow.View.ShowHiddenText
ActiveWindow.View.ShowHiddenText = True
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Format = False
    .Format = True
    .Wrap = wdFindContinue
    .MatchWildcards = False
    .Text = "^p^w"
    .Replacement.Text = "^p"
    .Execute Replace:=wdReplaceAll
    .Text = "^w^p"
    .Execute Replace:=wdReplaceAll
    .MatchWildcards = True
    .Text = "^13{2" & LS & "}"
    .Execute Replace:=wdReplaceAll
    .Wrap = wdFindStop
  End With
  Do While .Find.Execute = True
    With .Duplicate
      .Start = .Start   1
      .Text = vbNullString
    End With
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
For Each Tbl In ActiveDocument.Range.Tables
  With Tbl.Range
    Do While .Characters.First.Previous.Previous = vbCr
      .Characters.First.Previous.Previous = vbNullString
    Loop
    Do While .Characters.Last.Next = vbCr
      If .Characters.Last.Next.End = ActiveDocument.Range.End Then Exit Do
      If .Characters.Last.Next.Next.Information(wdWithInTable) = True Then Exit Do
      .Characters.Last.Next = vbNullString
    Loop
  End With
Next
ActiveWindow.View.ShowHiddenText = bHid
Application.ScreenUpdating = True
End Sub