Toggle PrintDrawingObjects

[JeanS]

Any help will be very much appreciated - coding skills were learned in Excel and are rusty anyway.

I have a letterhead template that has the header, footer and signature block in colour. All three are drawing objects. My ultimate aim is to print one copy of the letter on paper from tray 2 with the drawing objects and then print two copies without the drawing objects onto paper from tray 1. A previous attempt to print the two copies as draft documents has also failled. The reason I want to do this is to save colour toner in our colour laser printer. The code below works as far as the printing from the two different trays is concerned but it seems to ignore the newly added instruction to print without the drawing objects. Any solution that prints the copies without the graphics or (second best) with the graphics in black will suit me.



Sub PrintLetter()
' PrintLetter Macro
' Macro created 21/03/2006 by strettonj
MsgBox "Printing Letter"
With Options
.DefaultTray = "Tray2"
.PrintDrawingObjects = True
End With
Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
With Options
.DefaultTray = "Tray1"
.PrintDrawingObjects = False
End With
Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=2, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
Options.PrintDrawingObjects = True
End Sub

[Anne Troy]

Did you check the knowledgebase? I believe an entry exists for this.

[Anne Troy]

Here ya go. See if this helps you:
http://vbaexpress.com/kb/getarticle.php?kb_id=104

[JeanS]

Thanks Anne

Your post did help me but the problem I had was that I needed to delete the graphic in the header, and the footer and one containing a signature in the body of the letter. So your code made me realise that what I needed to do was create a copy of the letter with no HF, delete the sig block as per your code, print the copy letter then close without saving.

The code is copied below. The only odd thing is that it prints the two copies BEFORE it prints the original. Also the Application.ScreenUpdating lines don't seem to be working?? I'm not going to stress about either of these though. This solution might not be the most elegant but it achieves the three pieces of paper I need, each with the right stuff on it.

Thanks again.

Jean


Sub PrintLetter()
' PrintLetter Macro
' Macro created 21/03/2006 by strettonj
' Macro revised 31/08/2006 by strettonj
MsgBox "Printing Letter"
Application.ScreenUpdating = False
' Print Letterheaded copy
Options.DefaultTray = "Tray2"
Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
DoEvents
' Copy the text of the letter
Selection.WholeStory
Selection.Copy
' Create a new document, based on the BlankLH template - as letterhead minus header/footer
Documents.Add Template:= _
"C:\Documents and Settings\strettonj\Application Data\Microsoft\Templates\BlankLH.dot" _
, NewTemplate:=False, DocumentType:=0
' Paste letter into new document
Selection.PasteAndFormat (wdPasteDefault)
' Remove the graphic object containing signature
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^g"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
' Print two copies without header, footer or signature graphics
Options.DefaultTray = "Tray1"
Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=2, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, Background:=False, PrintToFile:= _
False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
' Close the copy document without saving changes, return to original and cancel selection
ActiveDocument.Close SaveChanges:=False
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Application.ScreenUpdating = True
End Sub

[Anne Troy]

Great.

Also, I've marked your code with VBA tags for readability. :)

[JeanS]

Great.

Also, I've marked your code with VBA tags for readability. :)

Anne

Sorry, I don't know what VBA tags are and I can't see anything on the screen after your post??

Jean

[Anne Troy]

Scroll down and you should see the green area in which to post a reply to this post. Right above the green area is a bunch of icons. One of the icons is darker green and white and it says VBA. If you click that, then type or paste your code, your code shows up as it did above.

:)

[JeanS]

Got it!

Thank you

Jean