Consulting

Results 1 to 2 of 2

Thread: Changing Portrait to Landscape size

  1. #1

    Changing Portrait to Landscape size

    I'm using Windows 10 and Office 365. The paper size is LETTER.
    I have created a procedure whereby a user can identify where they want to put a landscape page, they place the cursor and "press the button".

    This goes ahead and does all the necessary business and finally creates the new landscape page with the cursor waiting for something to be written within it.

    However, there is an "ah, yes, but..." when every so often, and without any reason for it, the single row tables within each of the headers or footers might not stretch themselves across the new width of the page. It's always one or the other of the tables.

    I cannot identify in the code where this is happening; and if it did then how to repair it. Lines 900 to 907 should stretch the two tables but obviously, sometimes they don't want to play.

    Here is my code:
    770       curRge.Select          'sets up the new landscape page
    780       With Selection.PageSetup
    790           .Orientation = wdOrientLandscape
    800           .TopMargin = CentimetersToPoints(2.2)
    810           .BottomMargin = CentimetersToPoints(2.3)
    820           .LeftMargin = oLeftMargin
    830           .RightMargin = oRightMargin
    840           .HeaderDistance = CentimetersToPoints(1.7)
    850           .FooterDistance = CentimetersToPoints(0.8)
    860           .SectionStart = wdSectionNewPage
    870           .OddAndEvenPagesHeaderFooter = False
    880           .DifferentFirstPageHeaderFooter = False
    890       End With
              'changes the widths of the tables in the header and footer
    900       With Selection
    910           .Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).AutoFitBehavior (wdAutoFitWindow)
    920           .Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Columns.DistributeWidth
    930           ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    940           .Sections(1).Footers(wdHeaderFooterPrimary).Range.Tables(1).AutoFitBehavior (wdAutoFitWindow)
    950           .Sections(1).Footers(wdHeaderFooterPrimary).Range.Tables(1).Rows.VerticalPosition = CentimetersToPoints(19.7)
    960           .Sections(1).Footers(wdHeaderFooterPrimary).Range.Tables(1).Rows.RelativeVerticalPosition = wdRelativeVerticalPositionPage
    970       End With
    980       With Selection.HeaderFooter.PageNumbers
    990           .RestartNumberingAtSection = False
    1000      End With
    1010      With ActiveWindow.ActivePane.View
    1020          .NextHeaderFooter
    1030      End With
    1040      With Selection.HeaderFooter.PageNumbers
    1050          .RestartNumberingAtSection = False
    1060      End With
    1070      ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
              'goes back to the new landscape page
    1080      curRge.Select
    1090      With Selection
    1100          .TypeParagraph
    1110          .TypeParagraph
    1120      End With
              'makes sure all headers and footers are unlinked
    1130      With Selection.Sections(1)
    1140          For Each pHeaderFooter In .Footers
    1150              pHeaderFooter.LinkToPrevious = False
                      
    1160          Next
    1170          For Each pHeaderFooter In .Headers
    1180              pHeaderFooter.LinkToPrevious = False
    1190          Next
    1200      End With
    Can anyone point out to me, please, where the existing code can be modified so that it always obeys the instruction for the tables in the relevant header or footer to stretch across the page?

    Thanks

    Roderick

  2. #2
    It is preferable to work with named ranges then the macro always knows where it is supposed to be working e.g.

    Dim oSection As Section
    Dim oHeader As HeaderFooter
    Dim oFooter As HeaderFooter
    Dim curRge As Range
        'insert a section break at the cursor
        Selection.InsertBreak wdSectionBreakNextPage
        Set curRge = Selection.Range
        '---------
        curRge.Text = vbCr & vbCr
        curRge.Collapse 0
        curRge.Select
        Set oSection = curRge.Sections(1)
        With oSection.PageSetup
            .Orientation = wdOrientLandscape
            .TopMargin = CentimetersToPoints(2.2)
            .BottomMargin = CentimetersToPoints(2.3)
            'it is not clear what the margin values are
            '.LeftMargin = oLeftMargin
            '.RightMargin = oRightMargin
            .HeaderDistance = CentimetersToPoints(1.7)
            .FooterDistance = CentimetersToPoints(0.8)
            .SectionStart = wdSectionNewPage
            .OddAndEvenPagesHeaderFooter = False
            .DifferentFirstPageHeaderFooter = False
        End With
        'changes the widths of the tables in the header and footer
        With oSection
            For Each oHeader In oSection.Headers
                If oHeader.Exists Then
                    With oHeader
                        .LinkToPrevious = False
                        .Range.Tables(1).AutoFitBehavior wdAutoFitWindow
                        .Range.Tables(1).Columns.DistributeWidth
                    End With
                End If
            Next oHeader
            For Each oFooter In oSection.Footers
                If oFooter.Exists Then
                    With oFooter
                        .LinkToPrevious = False
                        .Range.Tables(1).AutoFitBehavior wdAutoFitWindow
                        .Range.Tables(1).Rows.VerticalPosition = CentimetersToPoints(19.7)
                        .Range.Tables(1).Rows.RelativeVerticalPosition = wdRelativeVerticalPositionPage
                        .PageNumbers.RestartNumberingAtSection = False
                    End With
                End If
            Next oFooter
        End With
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •