Answered by:
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
Friday, March 7, 2014 11:52 AM
Answers
-
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 SubSub 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 SubSub 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]- Edited by macropodMVP Saturday, March 8, 2014 2:20 AM
- Marked as answer by Fei XueMicrosoft employee Thursday, March 13, 2014 11:33 AM
Saturday, March 8, 2014 2:10 AM -
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
Nextat the same location.
Cheers
Paul Edstein
[MS MVP - Word]- Edited by macropodMVP Sunday, March 9, 2014 11:09 AM
- Marked as answer by Fei XueMicrosoft employee Thursday, March 13, 2014 11:33 AM
Sunday, March 9, 2014 11:08 AM -
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 WithCheers
Paul Edstein
[MS MVP - Word]- Marked as answer by Fei XueMicrosoft employee Thursday, March 13, 2014 11:33 AM
Wednesday, March 12, 2014 9:37 AM
All replies
-
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 SubSub 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 SubSub 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]- Edited by macropodMVP Saturday, March 8, 2014 2:20 AM
- Marked as answer by Fei XueMicrosoft employee Thursday, March 13, 2014 11:33 AM
Saturday, March 8, 2014 2:10 AM -
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
Sunday, March 9, 2014 10:50 AM -
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
Nextat the same location.
Cheers
Paul Edstein
[MS MVP - Word]- Edited by macropodMVP Sunday, March 9, 2014 11:09 AM
- Marked as answer by Fei XueMicrosoft employee Thursday, March 13, 2014 11:33 AM
Sunday, March 9, 2014 11:08 AM -
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
Wednesday, March 12, 2014 9:01 AM -
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 WithCheers
Paul Edstein
[MS MVP - Word]- Marked as answer by Fei XueMicrosoft employee Thursday, March 13, 2014 11:33 AM
Wednesday, March 12, 2014 9:37 AM -
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 SubTuesday, March 18, 2014 5:26 PM -
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 .Findto:
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 .FindAs 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]Tuesday, March 18, 2014 10:57 PM -
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
Thursday, April 10, 2014 5:27 PM -
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]Thursday, April 10, 2014 10:02 PM -
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
- Edited by Hemal Kotak Friday, April 11, 2014 4:02 AM
Friday, April 11, 2014 4:02 AM -
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 SubSub 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 SubSub 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 FunctionSub 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]- Edited by macropodMVP Friday, April 11, 2014 5:00 AM
- Proposed as answer by macropodMVP Wednesday, December 10, 2014 11:14 PM
Friday, April 11, 2014 4:59 AM -
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)
Wednesday, December 10, 2014 12:40 PM -
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]Wednesday, December 10, 2014 11:23 PM