How to validate formatting of word document using word macro

Question

I wanted to validate formatting of word document, if format is not proper as specified in macro it Highlights that particular portion with some color.

formatting rules:

Font Type is : Times New Roman

Header -> font size 9

Footer -> font size 8

Title(Heading) -> font size 10

Table content -> font size 9

Body Text -> font size 10

Please suggest the macro or sample code would be of great help.

Regards,

Raj

Answer 1

The simplest way is to highlight all of the document, or just the parts using the Styles you're interested in (via Find/Replace), then use Find/Replace to remove the highlighting from whatever content conforms to your specifications. You don't really need a macro for this. Furthermore, the format of Table of Contents entries is controlled via the relevant TOC Styles, so you should only need to check that those Styles are properly defined; highlighting parts of a TOC field is problematic.

For the rest, though, you could use a macro like:

Sub Demo()
Application.ScreenUpdating = False
Dim Sctn As Section, HdFt As HeaderFooter
With ActiveDocument
  Options.DefaultHighlightColorIndex = wdYellow
  Call RngHiLite(.Range, "Body Text")
  Call RngNoHiLite(.Range, "Body Text", 10)
  Options.DefaultHighlightColorIndex = wdGreen
  Call RngHiLite(.Range, "Heading 1")
  Call RngNoHiLite(.Range, "Heading 1", 10)
  For Each Sctn In .Sections
    For Each HdFt In Sctn.Headers
      With HdFt
        If .LinkToPrevious = False Then
          Options.DefaultHighlightColorIndex = wdPink
          Call RngHiLite(.Range, "Header")
          Call RngNoHiLite(.Range, "Header", 9)
        End If
      End With
    Next
    For Each HdFt In Sctn.Footers
      With HdFt
        If .LinkToPrevious = False Then
          Options.DefaultHighlightColorIndex = wdTurquoise
          Call RngHiLite(.Range, "Footer")
          Call RngNoHiLite(.Range, "Footer", 8)
        End If
      End With
    Next
  Next
End With
Application.ScreenUpdating = True
End Sub

Sub RngHiLite(Rng As Range, Stl As String)
With ActiveDocument
  With Rng.Find
    .ClearFormatting
    .Text = ""
    With .Replacement
      .ClearFormatting
      .Highlight = True
      .Text = ""
    End With
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
    .Style = Stl
    .Execute Replace:=wdReplaceAll
  End With
End With
End Sub

Sub RngNoHiLite(Rng As Range, Stl As String, Fnt As Single)
With ActiveDocument
  With Rng.Find
    .ClearFormatting
    .Text = ""
    .Format = True
    With .Replacement
      .ClearFormatting
      .Highlight = False
      .Text = ""
    End With
    .Forward = True
    .Wrap = wdFindStop
    .Style = Stl
    With .Font
      .Size = Fnt
      .Name = "Times New Roman"
    End With
    .Execute Replace:=wdReplaceAll
  End With
End With
End Sub

---

Cheers
Paul Edstein
[MS MVP - Word]

Answer 2

Thanks Paul, this is really a great help.

About Table i was referring simple table, which we add anywhere in the document to store some kind of matrix data, not TOC.

Rest of the things are working perfect.

Thanks,

Regards,

Raj

Answer 3

OK, if your reference to 'Table content' in your first post is for a Style name, you could add:

Options.DefaultHighlightColorIndex = wdBrightGreen
Call RngHiLite(.Range, "Table content")
Call RngNoHiLite(.Range, "Table content", 9)

to the existing code, say, just before 'For Each Sctn In .Sections'. If, however, you're referring to tables that could have any Style applied, you could use:

Dim Tbl As Table
For Each Tbl In .Tables
  With Tbl.Range
    .HighlightColorIndex = wdBrightGreen
    With .Find
      .ClearFormatting
      .Text = ""
      .Format = True
      With .Replacement
        .ClearFormatting
        .Highlight = False
        .Text = ""
      End With
      .Forward = True
      .Wrap = wdFindStop
      With .Font
        .Size = 9
        .Name = "Times New Roman"
      End With
      .Execute Replace:=wdReplaceAll
    End With
  End With
Next

at the same location.

---

Cheers
Paul Edstein
[MS MVP - Word]

Answer 4

Hi Paul,

I have one query on the macro you have provided.

Header, Footer, Heading works fine, when we say body text, document might have many things (section in terms of word).

How can i highlight text where i can pass highlight everything which is of not Times new roman and size 10 and not part of header, footer and heading.

Thanks,

Hemal

Answer 5

How can i highlight text where i can pass highlight everything which is of not Times new roman and size 10 and not part of header, footer and heading.

I'm not sure what you want here.

If you only want to process a selected range, change ActiveDocument to Selection.

If you want to highlight all text in the body that is not 10pt Times New Roman and using the "Body Text" Style, change:

  Options.DefaultHighlightColorIndex = wdYellow
  Call RngHiLite(.Range, "Body Text")

to:

  .Range.HighlightColorIndex = wdYellow

If you want to highlight all text in the body that is not 10pt Times New Roman, without considering the Style, change:

  Options.DefaultHighlightColorIndex = wdYellow
  Call RngHiLite(.Range, "Body Text")
  Call RngNoHiLite(.Range, "Body Text", 10)

to:

  .Range.HighlightColorIndex = wdYellow
  With .Find
    .ClearFormatting
    .Text = ""
    .Format = True
    With .Replacement
      .ClearFormatting
      .Highlight = False
      .Text = ""
    End With
    .Forward = True
    .Wrap = wdFindStop
    With .Font
      .Size = 10
      .Name = "Times New Roman"
    End With
    .Execute Replace:=wdReplaceAll
  End With

---

Cheers
Paul Edstein
[MS MVP - Word]

Answer 6

Hi Paul,

i am facing few issues in validating formatting of document using macro, here with i have attached document where issues am facing, and macro copied below.

issue: 

1). in macro rule is set to highlight body text if it is not of Times New Roman with size 10, it works most of the place, but in few documents its not working properly, not able to identify the differences.

2). second rule is to highlight normal table content if it is not of Times New Roman with size 9.

here also, text is validated fine with macro, but when there are any numbered list used in table it highlights, even though if it is Times New Roman size 9.

Can you please help me review the macro with sample document attached here, and see what is the actual issue?

MACRO:

Sub HighlightFontErrors()
    'Header Error color= Pink
    'Footer Error color= Pink
    'Table Error color= Bright Green
    'all other sections Yellow
Dim userMsg, userResponse, msgTitle
Dim headerFontSize As Single
Dim footerFontSize As Single
Dim tableFontSize As Single
Dim bodyFontSize As Single
Dim sty
userMsg = "Is this document an Evaluation Agreement Template?"
msgTitle = "Document Type"
userResponse = MsgBox(userMsg, vbYesNo, msgTitle)
If userResponse = vbYes Then
    headerFontSize = 8
    footerFontSize = 8
    tableFontSize = 8
    bodyFontSize = 8
Else
    headerFontSize = 9
    footerFontSize = 8
    tableFontSize = 9
    bodyFontSize = 10
End If
Options.DefaultHighlightColorIndex = wdYellow
Application.ScreenUpdating = False
Dim curTrackRevisionSetting
curTrackRevisionSetting = ActiveDocument.TrackRevisions
If curTrackRevisionSetting = True Then
    ActiveDocument.TrackRevisions = False
End If
Dim Sctn As Section, HdFt As HeaderFooter
With ActiveDocument
   Options.DefaultHighlightColorIndex = wdYellow
   For Each sty In .Styles
    If sty.InUse = True Then
        Call RngHiLite(.range, sty.NameLocal)
        Call RngNoHiLite(.range, sty.NameLocal, bodyFontSize)
    End If
   Next
   
   'Highlight Table formatting error
   '==============
   Dim Tbl As Table
   For Each Tbl In .Tables
   With Tbl.range
     .HighlightColorIndex = wdBrightGreen
     With .Find
       .ClearFormatting
       .Text = ""
       .Format = True
       With .Replacement
         .ClearFormatting
         .Highlight = False
         .Text = ""
       End With
       .Forward = True
       .Wrap = wdFindStop
       With .Font
         .Size = tableFontSize
         .Name = "Times New Roman"
       End With
       .Execute Replace:=wdReplaceAll
     End With
   End With
Next
'==============
   For Each Sctn In .Sections
     For Each HdFt In Sctn.Headers
       With HdFt
         If .LinkToPrevious = False Then
           Options.DefaultHighlightColorIndex = wdPink
           Call RngHiLite(.range, "Header")
           Call RngNoHiLite(.range, "Header", headerFontSize)
         End If
       End With
     Next
     For Each HdFt In Sctn.Footers
       With HdFt
         If .LinkToPrevious = False Then
           Options.DefaultHighlightColorIndex = wdPink
           Call RngHiLite(.range, "Footer")
           Call RngNoHiLite(.range, "Footer", footerFontSize)
         End If
       End With
     Next
   Next
End With
Application.ScreenUpdating = True
ActiveDocument.TrackRevisions = curTrackRevisionSetting
End Sub

Sub RngHiLite(Rng As range, Stl As String)
With ActiveDocument
   With Rng.Find
     .ClearFormatting
     .Text = ""
     With .Replacement
       .ClearFormatting
       .Highlight = True
       .Text = ""
     End With
     .Forward = True
     .Wrap = wdFindStop
     .Format = True
     .Style = Stl
     .Execute Replace:=wdReplaceAll
   End With
End With
End Sub
Sub RngNoHiLite(Rng As range, Stl As String, Fnt As Single)
With ActiveDocument
   With Rng.Find
     .ClearFormatting
     .Text = ""
     .Format = True
     With .Replacement
       .ClearFormatting
       .Highlight = False
       .Text = ""
     End With
     .Forward = True
     .Wrap = wdFindStop
     .Style = Stl
     With .Font
       .Size = Fnt
       .Name = "Times New Roman"
     End With
     .Execute Replace:=wdReplaceAll
   End With
End With
End Sub

Sample document to execute macro

Answer 7

There are two main problems with your attached document:

1. The content mainly has the Normal Style applied, and that Style specifies 11pt Calibri text. Instead of respecting that or changing the style definition, throughout the document you have simply overridden the style definition with Times New Roman in various font sizes. That is bad practice and can lead to document corruption; indeed, that is what you now have, and that's causing some yellow highlighting to remain. You should define separate Styles with the various fonts you require and use those. Do that and the problems with the unexpected yellow highlights will go away.

2. The problem with the table numbers is that, in the cells concerned, the numbered paragraphs are attached to the end-of-cell markers. There seems to be no way of removing the highlight via the second Find/replace, so the better approach might be to avoid highlighting the compliant text to start with. To that end, change:

    Dim Tbl As Table
...
      With .Find

to:

    Dim Tbl As Table, TblCell As Cell, Rng As Range
    For Each Tbl In .Tables
    With Tbl.Range
      .HighlightColorIndex = wdNoHighlight
      For Each TblCell In .Cells
        Set Rng = TblCell.Range
        With Rng
          .End = .End - 1
          If .Font.Size <> tableFontSize Or .Font.Name <> "Times New Roman" Then
            .HighlightColorIndex = wdBrightGreen
          End If
        End With
      Next
      With .Find

As an aside, I do wonder why you're doing all this checking, when one could just as easily use a macro to enforce the required formatting...

---

Cheers
Paul Edstein
[MS MVP - Word]

Answer 8

Hi Paul,

Above macro works fine, there is slight change i need to do in it, i did try but that did not worked.

Change required: I have some place holders in document, those place holders are highlighted with Yellow color, so, when i run above macro those place holder highlight should not be removed(currently it is removing because of our find n replace kind of methods), basically those place holders should be exception for highlighting formatting validations.

This is very urgent, can you please help in this.

Thanks,

Hemal

Answer 9

Is there anything other than the highlighting that identifies these placeholders as such? Do they all always use the same yellow highlight colour?

---

Cheers
Paul Edstein
[MS MVP - Word]

Answer 10

Is there anything other than the highlighting that identifies these placeholders as such?

Answer: No

Do they all always use the same yellow highlight colour?

Answer: Yes

Answer 11

Try the following. Since your highlights are always yellow, I've changed the body text highlight colour to DarkYellow so you can differentiate the highlights that result from the macro and those that were present beforehand.

Sub Demo()
Application.ScreenUpdating = False
Dim Sctn As Section, HdFt As HeaderFooter
Dim Tbl As Table, HiLiteArr
With ActiveDocument
  Options.DefaultHighlightColorIndex = wdDarkYellow
  HiLiteArr = StoreHiLites(.Range)
  Call RngHiLite(.Range, "Body Text")
  Call RngNoHiLite(.Range, "Body Text", 10)
  Options.DefaultHighlightColorIndex = wdGreen
  Call RngHiLite(.Range, "Heading 1")
  Call RngNoHiLite(.Range, "Heading 1", 10)
  For Each Tbl In .Tables
    With Tbl.Range
      .HighlightColorIndex = wdBrightGreen
      With .Find
        .ClearFormatting
        .Text = ""
        .Format = True
        With .Replacement
          .ClearFormatting
          .Highlight = False
          .Text = ""
        End With
        .Forward = True
        .Wrap = wdFindStop
        With .Font
          .Size = 9
          .Name = "Times New Roman"
        End With
        .Execute Replace:=wdReplaceAll
      End With
    End With
  Next
  If UBound(HiLiteArr) > 0 Then Call RestoreHiLites(.Range, HiLiteArr)
  For Each Sctn In .Sections
    For Each HdFt In Sctn.Headers
      With HdFt
        If .LinkToPrevious = False Then
          Options.DefaultHighlightColorIndex = wdPink
          HiLiteArr = StoreHiLites(.Range)
          Call RngHiLite(.Range, "Header")
          Call RngNoHiLite(.Range, "Header", 9)
          If UBound(HiLiteArr) > 0 Then Call RestoreHiLites(.Range, HiLiteArr)
        End If
      End With
    Next
    For Each HdFt In Sctn.Footers
      With HdFt
        If .LinkToPrevious = False Then
          Options.DefaultHighlightColorIndex = wdTurquoise
          HiLiteArr = StoreHiLites(.Range)
          Call RngHiLite(.Range, "Footer")
          Call RngNoHiLite(.Range, "Footer", 8)
          If UBound(HiLiteArr) > 0 Then Call RestoreHiLites(.Range, HiLiteArr)
        End If
      End With
    Next
  Next
End With
Application.ScreenUpdating = True
End Sub

Sub RngHiLite(Rng As Range, Stl As String)
With Rng.Find
  .ClearFormatting
  .Text = ""
  With .Replacement
    .ClearFormatting
    .Highlight = True
    .Text = ""
  End With
  .Forward = True
  .Wrap = wdFindStop
  .Format = True
  .Style = Stl
  .Execute Replace:=wdReplaceAll
End With
End Sub

Sub RngNoHiLite(Rng As Range, Stl As String, Fnt As Single)
'With ActiveDocument
  With Rng.Find
    .ClearFormatting
    .Text = ""
    .Format = True
    With .Replacement
      .ClearFormatting
      .Highlight = False
      .Text = ""
    End With
    .Forward = True
    .Wrap = wdFindStop
    .Style = Stl
    With .Font
      .Size = Fnt
      .Name = "Times New Roman"
    End With
    .Execute Replace:=wdReplaceAll
  End With
'End With
End Sub
 
Function StoreHiLites(Rng As Range)
Dim StrTmp As String
With Rng
  With .Find
    .ClearFormatting
    .Text = ""
    .Format = True
    .Highlight = True
    With .Replacement
      .ClearFormatting
      .Text = ""
    End With
    .Forward = True
    .Wrap = wdFindStop
    .Execute
  End With
  Do While .Find.Found
    StrTmp = StrTmp & .Start & "." & .End & "."
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
StoreHiLites = Split(StrTmp, ".")
End Function

Sub RestoreHiLites(Rng As Range, HiLiteArr)
Dim i As Long
With Rng
  For i = 0 To UBound(HiLiteArr) - 1 Step 2
    With .Duplicate
      .End = .Start + HiLiteArr(i + 1)
      .Start = .Start + HiLiteArr(i)
      .HighlightColorIndex = wdYellow
    End With
  Next
End With
ReDim HiLiteArr(0)
End Sub

---

Cheers
Paul Edstein
[MS MVP - Word]

Answer 12

Hello Mac,

I have used your code and it is working fine for headings but when i am using same code for to highlight the text of Normal style or table text or Caption style it is not working.It is highlighting whole text with Normal style although text is fine and it should not get higlighted.

 Options.DefaultHighlightColorIndex = wdPink
   Call RngHiLite(.Range, "caption")
   Call RngNoHiLite(.Range, "caption", 10)

Options.DefaultHighlightColorIndex = wdYellow

Call RngHiLitePreH(.Range, "Table Heading")

   Call RngNoHiLitePreHB(.Range, "Table Heading", 10)

 

Answer 13

The code will not highlight a range that conforms to the specifications in the macro. As coded, in addition to the font size, it requires all text to be in Times New Roman.

---

Cheers
Paul Edstein
[MS MVP - Word]