Word Macro to provide page no. of document without title

[dandgeniti]

Hi,

We receive large no. of word documents which have title on each page. Title text is different for each document however specific style used for title is "Arial font, Font size 12, Bold".

Although title should be present on each page of the document, sometimes writers miss to add title on some pages.

Can we create macro which will search through document and list page numbers which are missing title.


Thanks in advance for your support and sorry for bad English.

[macropod]

So where is this content to be found - in the body of the document or in the page header? If it's in the document body, is it supposed to be the first paragraph, or can it occur anywhere? And what is the Style's name?

[dandgeniti]

Thanks for the reply and help.

title is present in the body of the document and always present on the top (First 3 to 4 lines max). Its not present anywhere else on that page.

I think Style name will not help because on first page of document it's caption and for rest of the pages it's normal. However style properties are same on all the pages i.e. "Arial font, Font size 12, Bold".

[macropod]

Try:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, StrPgs As String
StrPgs = ","
With ActiveDocument.Range
For i = 1 To .ComputeStatistics(wdStatisticPages)
StrPgs = StrPgs & i & ","
Next
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Format = True
With .Font
.Name = "Arial"
.Size = 12
.Bold = True
End With
.Forward = True
.Wrap = wdFindStop
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
If .End = ActiveDocument.Range.End Then Exit Do
StrPgs = Replace(StrPgs, "," & .Information(wdActiveEndAdjustedPageNumber) & ",", ",")
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
StrPgs = Replace(Trim(Replace(StrPgs, ",", " ")), " ", ",")
Application.ScreenUpdating = True
If StrPgs = "" Then
MsgBox "No Titles missing"
Else
MsgBox "Titles missing on pages: " & StrPgs
End If
End Sub

[dandgeniti]

Thank you so much! It's working great!!!! :bow:

Wish I had these skills.