Condensing Web Pages for Printing

I occasionally print out really long articles for bedtime reading. If I print directly from the browser, I end up with a TON of pages. So usually what I do is copy the text to Word, shrink the margins down to the minimum (except I go 0.6” top margin to allow room for stapling), convert to two columns with a line and 0.2” between them, and change all the text to Times New Roman 8pt. It ends up looking something like this (from this SI Andre Agassi article I’m looking forward to):

I recorded a macro and mapped it to a toolbar button so I can do it in one click. Here’s the resulting code, if you want to use it:

Sub SaveInk()
  WordBasic.PageSetupMargins Tab:=0, PaperSize:=0, TopMargin:="0.6", _
    BottomMargin:="0.25", LeftMargin:="0.25", RightMargin:="0.25", Gutter:= _
    "0", PageWidth:="8.5", PageHeight:="11", Orientation:=0, FirstPage:=0, _
    OtherPages:=0, VertAlign:=0, ApplyPropsTo:=4, FacingPages:=0, _
    HeaderDistance:="0.5", FooterDistance:="0.5", SectionStart:=2, _
    OddAndEvenPages:=0, DifferentFirstPage:=0, Endnotes:=0, LineNum:=0, _
    CountBy:=0, TwoOnOne:=0, GutterPosition:=0, LayoutMode:=0, DocFontName:= _
    "", FirstPageOnLeft:=0, SectionType:=1, FolioPrint:=0, ReverseFolio:=0, _
    FolioPages:=1
  If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
    ActiveWindow.Panes(2).Close
  End If
  If ActiveWindow.ActivePane.View.Type <> wdPrintView Then
    ActiveWindow.ActivePane.View.Type = wdPrintView
  End If
  With ActiveDocument.PageSetup.TextColumns
    .SetCount NumColumns:=2
    .EvenlySpaced = True
    .LineBetween = True
    .Width = InchesToPoints(3.9)
    .Spacing = InchesToPoints(0.2)
  End With
  Selection.WholeStory
  With Selection.ParagraphFormat
    .LeftIndent = InchesToPoints(0)
    .RightIndent = InchesToPoints(0)
    .SpaceBefore = 0
    .SpaceBeforeAuto = False
    .SpaceAfter = 6
    .SpaceAfterAuto = False
    .LineSpacingRule = wdLineSpaceSingle
    .Alignment = wdAlignParagraphLeft
    .WidowControl = True
    .KeepWithNext = False
    .KeepTogether = False
    .PageBreakBefore = False
    .NoLineNumber = False
    .Hyphenation = True
    .FirstLineIndent = InchesToPoints(0)
    .CharacterUnitLeftIndent = 0
    .CharacterUnitRightIndent = 0
    .CharacterUnitFirstLineIndent = 0
    .LineUnitBefore = 0
    .LineUnitAfter = 0
    .MirrorIndents = False
    .TextboxTightWrap = wdTightNone
  End With
  Selection.Font.Name = "Times New Roman"
  Selection.Font.Size = 8
End Sub