Attribute VB_Name = "NewMacros"
Sub Print_Diff_Header()
Attribute Print_Diff_Header.VB_Description = "Print each page with different header: 2001.09.05, dr. Nagy Ferenc"
Attribute Print_Diff_Header.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.Print_Diff_Header"
'
' Print_Diff_Header Makró
' Print each page with different header: 2001.09.05, dr. Nagy Ferenc
'
Dim intPageNumber As Integer
Dim intFromPageNumber As Integer, intToPageNumber As Integer
Dim strHeaderText As String, strFooterText As String
Dim strFromToPage As String
Dim intPageNumberInFooter As Integer
intPageNumberInFooter = MsgBox("Do you want to add page numbers to the footer?", vbYesNoCancel, "Print each page with different header and footer")
If intPageNumberInFooter = vbCancel Then Exit Sub
intFromPageNumber = Val(InputBox("From page number", "Print each page with different header and footer", 1))
intToPageNumber = Val(InputBox("To page number", "Print each page with different header and footer", 5))
For intPageNumber = intFromPageNumber To intToPageNumber
'Replace header and footer texts with your own ones
Select Case intPageNumber
Case 1
strHeaderText = "HHHHHHHHHHHHHHHAAAAAAAAAAAAA"
strFooterText = "FFFFFFFFFFFFFFFAAAAAAAAAAAAA"
Case 2
strHeaderText = "HHHHHHHHHHHHHHHBBBBBBBBBBBBB"
strFooterText = "FFFFFFFFFFFFFFFBBBBBBBBBBBBB"
Case 3
strHeaderText = "HHHHHHHHHHHHHHHCCCCCCCCCCCCC"
strFooterText = "FFFFFFFFFFFFFFFCCCCCCCCCCCCC"
Case 4
strHeaderText = "HHHHHHHHHHHHHHHDDDDDDDDDDDDD"
strFooterText = "FFFFFFFFFFFFFFFDDDDDDDDDDDDD"
Case 5
strHeaderText = "HHHHHHHHHHHHHHHEEEEEEEEEEEEE"
strFooterText = "FFFFFFFFFFFFFFFEEEEEEEEEEEEE"
'case 6 ... 'Add more cases
End Select
If intPageNumberInFooter Then 'Add page number to footer if requested
strFooterText = strFooterText & "" & CStr(-intPageNumber) & "-"
End If
strFromToPage = CStr(intPageNumber) & CStr(-intPageNumber)
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Or ActiveWindow.ActivePane.View.Type _
= wdMasterView Then
ActiveWindow.ActivePane.View.Type = wdPageView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.TypeText Text:=strHeaderText 'Header text replaced
If Selection.HeaderFooter.IsHeader = True Then
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Else
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
End If
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.TypeText Text:=strFooterText 'Footer text replaced
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'Print out only one page
Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
wdPrintDocumentContent, Copies:=1, _
Pages:=strFromToPage, _
PageType:= _
wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False
Next intPageNumber
End Sub