Attribute VB_Name = "NewMacros" Sub Fine_print() ' ' Fine_print Macro ' Macro recorded 08/04/01 by ' Dim Message, Style, Title, Default, Response Message = "Have you chosen the correct printer and A4 size paper?" ' Define message. Style = vbYesNo + vbQuestion + vbDefaultButton2 ' Define buttons. Title = "Fine print macro" ' Define title. Response = MsgBox(Message, Style, Title) If Response = vbNo Then ' User chose Yes. Message = "Please go to File-->Print to set the printer and paper size." ' Define message. Style = vbDefaultButton2 ' Define buttons. Response = MsgBox(Message, Style, Title) Exit Sub End If Message = "Enter an Even page number" ' Set prompt. Title = "Fine print macro" ' Set title. Default = "24" ' Set default. ' Display message, title, and default value. N = InputBox(Message, Title, Default) a = 1 print_list = "" Do While a <= (N / 2) If a = (N / 2) Then print_list = print_list & (N + 1 - a) & "," & a Else If (a + 2) > (N / 2) Then print_list = print_list & (N + 1 - a) & "," & a & "," & (a + 1) & "," & (N - a) Else print_list = print_list & (N + 1 - a) & "," & a & "," & (a + 1) & "," & (N - a) & "," End If End If a = a + 2 Loop Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _ wdPrintDocumentContent, Copies:=1, Pages:= _ print_list, PageType:=wdPrintAllPages, ManualDuplexPrint:=False, Collate:=True, _ Background:=True, PrintToFile:=False, PrintZoomColumn:=2, PrintZoomRow:=1 _ , PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0 End Sub