ActiveDocument.Printout issue - vba

Question

I have two word documents, source and target. My target document is pulling values from a table inside source document and putting those concatenated values stored inside a variable named ReportHeader into it's page header. I have used two For-Next loops, the outer loops takes care of designated rows inside source document and this loop begins at 6th row till count of total rows inside that table.
My inner loop named "For xPages = 1 To numPages" takes care of number of parges required for each Annexure that it finds inside the table and loops through found number of pages for a particular Annexure reference.
Below is reference screenshot of my table. Please ignore the fact the few preceding lines of my tableare not being shown here. My business begins with 6th row that shows Annexure A.
Everything works fine as long as I test values in Debug.print or Msgbox but when I sent these values for printing using ActiveDocument.PrintOut, I notice an abnormal printing behaviour. First few rows starting at row 6 of table are ignored and later not all the pages are sent to printing.
Any feedback from you guys would be much appreciated.
Thanks
Syed
Sub PrintMyHeaders()
Dim r As Range
Dim sourceDoc, jobNumber, AnnexureRaw, Annexure, ReportHeader As String
Dim numPages As Integer
Application.ScreenUpdating = False
jobNumber = InputBox("Enter job number")
sourceDoc = ActiveDocument.Name
ActiveDocument.Tables(3).Range.ListFormat.RemoveNumbers
Set r = ActiveDocument.Tables(3).Range
For Each doc In Documents
If doc.Name = "Template.doc" Then Found = True
Next doc
If Found <> True Then
Documents.Open FileName:="C:\Users\smi\Documents\Template.doc"
Else
Documents("Template.doc").Activate
End If
Documents(sourceDoc).Activate
For i = 6 To r.Rows.Count
AnnexureRaw = Replace(r.Rows(i).Cells(2).Range.Text, "", "")
Annexure = Replace(AnnexureRaw, Chr(13), "")
numPages = Val(r.Rows(i).Cells(3).Range.Text)
For xPages = 1 To numPages
counter = counter + 1
ReportHeader = "PAGE " & xPages & " OF " & numPages & vbCrLf _
& "OUR REF: TKU-" & jobNumber & "/2018" & vbCrLf _
& "ANNEXURE : " & Chr(34) & Annexure & Chr(34)
Documents("Template.doc").Activate
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.Font.Name = "Arial"
Selection.Font.Size = 8
Selection.Font.Bold = True
Selection.Text = ReportHeader
Selection.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
Selection.ParagraphFormat.LineSpacing = 6
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
ActiveDocument.PrintOut
'Debug.Print ReportHeader & vbCrLf
Documents(sourceDoc).Activate
Next xPages
Next
Documents("template.doc").Activate
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
Documents(sourceDoc).Activate
Application.ScreenUpdating = True
End Sub

Answer 1

When printing out documents in relatively quick succession, things can get "mixed up" if background printing is turned on. This is an option in Word:
File/Options/Advanced, section "Print"
In the object model, to turn it off programmatically you can use the following. If the user likes having it turned on, save the current setting, turn it off, then restore the setting at the end of the code:
Options.PrintBackground = False
Since speed of execution is a concern, your code can be optimized. The following suggestions can also help to make it more self-documenting. Note that I'm not testing, just writing from the top of my head, so I may make a typo or two...
Put Option Explicit at the top of your code modules. This will save you from frustrating error messages if you mistype a variable name.
Use declared objects throughout. Referring back to ActiveDocument each time is less efficient (VBA has to figure out which it is, every time. Also, the active document could change during code execution, which would mess things up.) Ditto for repeatedly requesting Tables(3).
If your concern when looping a collection is to ensure a certain member is present (a particular document, in your case) you can use Exit For to break off the loop before all members have been queried.
It's not necessary to activate a document in order to work with it in code. Once you have Document objects, that's all you need.
It's also not necessary to fiddle with the Views in order to work with a header or footer. I've deleted those lines.
I hope I've kept "everything straight"!
Option Explicit
Sub PrintMyHeaders()
Dim r As Range
Dim sourceDoc, jobNumber, AnnexureRaw, Annexure, ReportHeader As String
Dim numPages As Integer
Dim sourceTable as Word.Table, doc as Word.Document
Dim tDoc as Word.Document
Application.ScreenUpdating = False
jobNumber = InputBox("Enter job number")
Set sourceDoc = ActiveDocument
Set sourceTable = sourceDoc.Tables(3)
sourceTable.Range.ListFormat.RemoveNumbers
Set r = sourceTable.Range
For Each doc In Documents
If doc.Name = "Template.doc" Then
Found = True
Exit For
End If
Next doc
If Found <> True Then
Set tDoc = Documents.Open(FileName:="C:\Users\smi\Documents\Template.doc")
Else
Set tDoc = Documents("Template.doc")
End If
For i = 6 To r.Rows.Count
AnnexureRaw = Replace(r.Rows(i).Cells(2).Range.Text, "", "")
Annexure = Replace(AnnexureRaw, Chr(13), "")
numPages = Val(r.Rows(i).Cells(3).Range.Text)
For xPages = 1 To numPages
counter = counter + 1
ReportHeader = "PAGE " & xPages & " OF " & numPages & vbCrLf _
& "OUR REF: TKU-" & jobNumber & "/2018" & vbCrLf _
& "ANNEXURE : " & Chr(34) & Annexure & Chr(34)
Dim rngHeader as Word.Range
Set rngHeader = tDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range
rngHeader.Font.Name = "Arial"
rngHeader.Font.Size = 8
rngHeader.Font.Bold = True
rngHeader.Text = ReportHeader
rngHeader.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
rngHeader.ParagraphFormat.LineSpacing = 6
rngHeader.ParagraphFormat.Alignment = wdAlignParagraphRight
tDoc.PrintOut
'Debug.Print ReportHeader & vbCrLf
Next xPages
Next
tDoc.Close SaveChanges:=wdDoNotSaveChanges
Application.ScreenUpdating = True
End Sub