This problem has intrigued me and the following code used in conjunction
with the listprinters function mentioned on my web page will examine the
document for coloured text and graphical content. If either or both are
found it prompts for the user to make a decision about which printer to use,
otherwise it prints to the default printer.
See the web page for more detail and the listprinters function, but the
initial effort at producing the code resulted in the following. I have
disabled the line that prints the document in favour of a message box that
names the printer to which the document will be directed, thus saving ink
and paper while testing
Note that in a large document with no graphics and coloured font near to the
end, the macro could take a while to run.
I don't suppose for one minute that I have covered all possible scenarios
where colour may be involved. The macro can be seen merely as a starting
point.
Dim oWord As Range
Dim ovars As Variables
Dim wCol As Word.WdColorIndex
Dim sPrCol As String
Dim sPrinter As String
Dim StrPrinters As Variant, i As Long
With ActiveDocument
Set ovars = .Variables
ovars("PrintCol").Value = 0
If .InlineShapes.Count > 0 Then
ovars("PrintCol").Value = 1
GoTo PrintNow
End If
If .Shapes.Count > 0 Then
ovars("PrintCol").Value = 1
GoTo PrintNow
End If
For Each oWord In .Words
wCol = oWord.Font.ColorIndex
If wCol <> wdAuto And wdBlack Then
ovars("PrintCol").Value = 1
Exit For
End If
Next oWord
PrintNow:
sPrinter = ActivePrinter
If ovars("printcol").Value = 1 Then
sPrCol = MsgBox("This document contains graphics " & _
"and or coloured text." & vbCr & _
"Do you wish to print in colour?", _
vbYesNo, "Print Colour")
If sPrCol = vbYes Then
StrPrinters = ListPrinters
If IsBounded(StrPrinters) Then
For i = LBound(StrPrinters) To UBound(StrPrinters)
If InStr(UCase(StrPrinters(i)), "COLOR") Then
ActivePrinter = StrPrinters(i)
GoTo PrintDoc
End If
Next i
sPrCol = MsgBox("Colour printer not available" & vbCr & _
"Do you wish to print on the default printer?",
_
vbYesNo, "Print Colour")
If sPrCol = vbNo Then Exit Sub
Else
MsgBox "No printers found", vbInformation, "Print Colour"
Exit Sub
End If
End If
End If
PrintDoc:
MsgBox ActivePrinter
'.PrintOut
ActivePrinter = sPrinter
End With