Landscape Pages

Public Sub Layout_InsertLandscapePage() 
Dim lsectionno As Long 
Dim oCurrentSection As Section 
Dim oPreviousSection As Section 
Dim oRange As Range 

   lsectionno = Selection.Information(wdActiveEndSectionNumber) 
   Set oCurrentSection = ActiveDocument.Sections(lsectionno) 
   If (oCurrentSection.PageSetup.Orientation = wdOrientLandscape) Then 
      Exit Sub 
   End If 
   Set oCurrentSection = Selection.Sections(1) 
   Selection.MoveUp wdLine, 1 
   Set oPreviousSection = Selection.Sections(1) 
   Selection.MoveDown wdLine, 1 
   If (oPreviousSection.Index = oCurrentSection.Index) Then 
      Selection.TypeParagraph 
      Selection.InsertBreak (wdSectionBreakNextPage) 
      With Selection 
          .TypeParagraph 
          Set oRange = Selection.Range 
          oRange.MoveStart wdParagraph, -1 
          oRange.Select 
          .Style = ActiveDocument.Styles("Heading 1") 
          .TypeText "New Landscape Section" 
          Set oRange = Selection.Range 
          oRange.MoveStart wdParagraph, 1 
          oRange.Select 
          If (Selection_IsAtEndOfDocument = False) Then 
             .TypeParagraph 
             .TypeParagraph 
             .InsertBreak (wdSectionBreakNextPage) 
             .Delete 
             Set oRange = Selection.Range 
             oRange.Move wdParagraph, -3 
             oRange.Select 
          End If 
          Call Layout_SwitchToLandscapeSection(True) 
      End With 
   Else 
   End If 
   Set oRange = Nothing 
End Sub 

Public Sub Layout_SwitchToLandscapeSection(ByVal bLinkToPrevious As Boolean) 
Dim lsectionno As Long 
Dim oCurrentSection As Section 
Dim oNextSection As Section 
Dim oHeaderRange As Range 
Dim oFooterRange As Range 

   lsectionno = Selection.Information(wdActiveEndSectionNumber) 
   Set oCurrentSection = ActiveDocument.Sections(lsectionno) 
   If (oCurrentSection.PageSetup.Orientation = WdOrientation.wdOrientLandscape) Then 
      'do nothing
   Else 
      If (ActiveDocument.Sections.Count > lsectionno) Then 
          Set oNextSection = ActiveDocument.Sections(lsectionno + 1) 
          oNextSection.Headers(WdHeaderFooterIndex.wdHeaderFooterPrimary).LinkToPrevious = bLinkToPrevious 
          oNextSection.Footers(WdHeaderFooterIndex.wdHeaderFooterPrimary).LinkToPrevious = bLinkToPrevious 
      End If 
      oCurrentSection.Headers(WdHeaderFooterIndex.wdHeaderFooterPrimary).LinkToPrevious = bLinkToPrevious 
      oCurrentSection.Footers(WdHeaderFooterIndex.wdHeaderFooterPrimary).LinkToPrevious = bLinkToPrevious 
      oCurrentSection.PageSetup.Orientation = WdOrientation.wdOrientLandscape 
'always reset these, regardless of linktoprevious or not
      Set oHeaderRange = oCurrentSection.Headers(WdHeaderFooterIndex.wdHeaderFooterPrimary).Range 
      oHeaderRange.ParagraphFormat.TabStops.Item(1).Position = CentimetersToPoints(25.75) 
      Set oFooterRange = oCurrentSection.Footers(WdHeaderFooterIndex.wdHeaderFooterPrimary).Range 
      oFooterRange.ParagraphFormat.TabStops.Item(1).Position = CentimetersToPoints(8.5) 
      oFooterRange.ParagraphFormat.TabStops.Item(2).Position = CentimetersToPoints(25.75) 
   End If 
   Set oNextSection = Nothing 
   Set oHeaderRange = Nothing 
   Set oFooterRange = Nothing 
   Set oCurrentSection = Nothing 
End Sub 

Public Sub Layout_InsertPortraitPage() 
Dim lsectionno As Long 
Dim oCurrentSection As Section 
Dim oPreviousSection As Section 
Dim oRange As Range 

   lsectionno = Selection.Information(wdActiveEndSectionNumber) 
   Set oCurrentSection = ActiveDocument.Sections(lsectionno) 
   If (oCurrentSection.PageSetup.Orientation = wdOrientPortrait) Then 
      Exit Sub 
   End If 
   Set oCurrentSection = Selection.Sections(1) 
   Selection.MoveUp wdLine, 1 
   Set oPreviousSection = Selection.Sections(1) 
   Selection.MoveDown wdLine, 1 
   If (oPreviousSection.Index = oCurrentSection.Index) Then 
      Selection.TypeParagraph 
      Selection.InsertBreak (wdSectionBreakNextPage) 
      With Selection 
          .TypeParagraph 
          Set oRange = Selection.Range 
          oRange.MoveStart wdParagraph, -1 
          oRange.Select 
          .Style = ActiveDocument.Styles("Heading 1") 
          .TypeText "New Portrait Section" 
          Set oRange = Selection.Range 
          oRange.MoveStart wdParagraph, 1 
          oRange.Select 
          If (Selection_IsAtEndOfDocument = False) Then 
             .TypeParagraph 
             .TypeParagraph 
             .InsertBreak (wdSectionBreakNextPage) 
             .Delete 
             Set oRange = Selection.Range 
             oRange.Move wdParagraph, -3 
             oRange.Select 
          End If 
          Call Layout_SwitchToPortraitSection(True) 
      End With 
   Else 
   End If 
   Set oRange = Nothing 
   Set oCurrentSection = Nothing 
End Sub 

Public Sub Layout_SwitchToPortraitSection(ByVal bLinkToPrevious As Boolean) 
Dim lsectionno As Long 
Dim ipageno As Integer 
Dim oCurrentSection As Section 
Dim oNextSection As Section 
Dim oHeaderRange As Range 
Dim oFooterRange As Range 

   lsectionno = Selection.Information(wdActiveEndSectionNumber) 
   Set oCurrentSection = ActiveDocument.Sections(lsectionno) 
   If (oCurrentSection.PageSetup.Orientation = wdOrientPortrait) Then 
   Else 
      If (ActiveDocument.Sections.Count > lsectionno) Then 
          Set oNextSection = ActiveDocument.Sections(lsectionno + 1) 
          oNextSection.Headers(wdHeaderFooterPrimary).LinkToPrevious = bLinkToPrevious 
          oNextSection.Footers(wdHeaderFooterPrimary).LinkToPrevious = bLinkToPrevious 
      End If 
      oCurrentSection.Headers(wdHeaderFooterPrimary).LinkToPrevious = bLinkToPrevious 
      oCurrentSection.Footers(wdHeaderFooterPrimary).LinkToPrevious = bLinkToPrevious 
      oCurrentSection.PageSetup.Orientation = wdOrientPortrait 
      If (bLinkToPrevious = False) Then 
         Set oHeaderRange = oCurrentSection.Headers(wdHeaderFooterPrimary).Range 
         oHeaderRange.ParagraphFormat.TabStops.Item(1).Position = CentimetersToPoints(17) 
         Set oFooterRange = oCurrentSection.Footers(wdHeaderFooterPrimary).Range 
         oFooterRange.ParagraphFormat.TabStops.Item(1).Position = CentimetersToPoints(8.5) 
         oFooterRange.ParagraphFormat.TabStops.Item(2).Position = CentimetersToPoints(17) 
      End If 
   End If 
   Set oNextSection = Nothing 
   Set oHeaderRange = Nothing 
   Set oFooterRange = Nothing 
   Set oCurrentSection = Nothing 
End Sub