Detect color in document

[Richard]

Is it possible to accurately detect color in each page of a document with
VBA?

I need to know which page will show color when they are printed to a color
printer.

 

[Jay Freedman]

In theory it should be possible, but the implementation will be pure
drudgery and the result will probably be so slow as to be unusable.

First, Word has only the faintest of concepts of a "page". A document
is constantly being repaginated based on every character or other
object that occupies space, data from the font files and printer
driver about character metrics, paragraph indents and line spacing,
and many other factors. Even if you know the range that constitutes a
particular page now, it may not be applicable after a single edit or
when the document is transferred to a computer with a different
printer driver. It's a mess.

Next, consider that each character in a text can be a different color.
There are graphics of several types, embedded objects, backgrounds,
shading, borders, and a gazillion other ways for a spot of color to
appear on a page, and your code would have to check each of them
individually.

I think it would be easier to scan manually through the document in
Print Preview and take notes about where the color appears.

Have fun!

--
Regards,
Jay Freedman
Microsoft Word MVP
Email cannot be acknowledged; please post all follow-ups to the
newsgroup so all may benefit.

 

[Richard]

Thanks for the detailed answer. What if we're only interested in checking
text.
Is it possible to detect color in each page of a document with VBA (and
we'll automatically assume that pages with graphics contain color)?

We can't do this manually b/c the docs are about 135 pages and we need to
process about 40 docs a day.

 

[Jay Freedman]

OK, under the conditions you stated -- and also that the macro doesn't
check headers, footers, footnotes, endnotes, or textboxes -- the
following should work. There might be a few pathological cases where
it either says there's color but the color doesn't print (e.g., hidden
text that contains color is displayed on screen, but the option to
print hidden text is turned off) or it misses color that will print --
I didn't spend a lot of time looking for test documents.

Note that the page numbers shown as the results are absolute numbers
counted from the start of the document; if the document contains any
sections with page number restarts, this won't match the "adjusted"
page numbers.

Sub ColorPages()
' Make a list of pages whose body text
' contains font color other than wdColorAutomatic

Dim pgNo As Long
Dim strColorPages As String

BlackToAuto

For pgNo = 1 To ActiveDocument.Range _
.Information(wdActiveEndPageNumber)
Selection.GoTo What:=wdGoToPage, _
Which:=wdGoToAbsolute, Count:=pgNo
If IsPageColored() Then
strColorPages = strColorPages & pgNo & " "
End If
Next

Selection.HomeKey Unit:=wdStory

If Len(strColorPages) = 0 Then
MsgBox "No pages contain color"
Else
' you can replace the MsgBox with some other output method
MsgBox "These pages contain color:" & vbCr & strColorPages
End If
End Sub

Function IsPageColored() As Boolean
' Check body text of current page for
' font color other than wdColorAutomatic

Dim pageRange As Range
Dim result As Boolean

result = False

' select entire current page
ActiveDocument.Bookmarks("\Page").Select

' save its range for later comparison
Set pageRange = Selection.Range

' collapse Selection to start of page
Selection.Collapse wdCollapseStart

If Selection.Font.Color <> wdColorAutomatic Then
' right away it has color
result = True
Else
' extend to the end of the current color run
Selection.SelectCurrentColor

' check whether the end is still on the same page
If Selection.End < pageRange.End Then
' there's at least one non-Auto character
' on the page after the selection
result = True
End If
End If

IsPageColored = result
End Function

Private Sub BlackToAuto()
' just in case some characters are explicitly set
' to Black, convert them to Automatic
Dim oRg As Range
Set oRg = ActiveDocument.Range
With oRg.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Font.Color = wdColorBlack
.Replacement.Text = ""
.Replacement.Font.Color = wdColorAutomatic
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
End Sub

--
Regards,
Jay Freedman
Microsoft Word MVP
Email cannot be acknowledged; please post all follow-ups to the
newsgroup so all may benefit.