View Single Post
 
Old 01-26-2022, 10:38 PM
Peterson Peterson is offline Windows 10 Office 2019
Competent Performer
 
Join Date: Jan 2017
Posts: 143
Peterson is on a distinguished road
Default

Try this:
Code:
Sub PageSize_SetVarious() ' 01/26/2022

    Dim strPageSize As String
    Dim strPageWidth As String, strPageHeight As String, strTopMargin As String, _
    strBottomMargin As String, strLeftMargin As String, strRightMargin As String, _
    strHeaderDistance As String, strFooterDistance As String
    
    ' Prompt user for page size:
    strPageSize = InputBox("Enter the page size you want (enter the numeral):" & _
    vbCrLf & vbCrLf & " 1.    5.5 x 8.5" & vbCrLf & " 2.    6 x 9" & _
    vbCrLf & " 3.    6.14 x 9.21" & vbCrLf & " 4.    7 x 10" & _
    vbCrLf & " 5.    8.25 x 11" & vbCrLf & _
    vbCrLf & "Specify Page Size:")

    ' If user cancels, exit sub:
    If strPageSize = vbNullString Then
        Exit Sub
    End If
    
    Select Case strPageSize
    
        ' Modify the margin and header/footer values to your needs.
        ' If you don't need to, delete these lines from each Case,
        ' and as noted below.
        Case 1 ' 5.5 x 8.5
            strPageWidth = "5.5"
            strPageHeight = "8.5"
            
            strTopMargin = "0.3"
            strBottomMargin = "0.3"
            strLeftMargin = "0.3"
            strRightMargin = "0.3"
            strHeaderDistance = "0.2"
            strFooterDistance = "0.2"
        Case 2 ' 6 x 9
            strPageWidth = "6"
            strPageHeight = "9"
            
            strTopMargin = "0.3"
            strBottomMargin = "0.3"
            strLeftMargin = "0.3"
            strRightMargin = "0.3"
            strHeaderDistance = "0.2"
            strFooterDistance = "0.2"
        Case 3 ' 6.14 x 9.21
            strPageWidth = "6.14"
            strPageHeight = "9.21"
            
            strTopMargin = "0.3"
            strBottomMargin = "0.3"
            strLeftMargin = "0.3"
            strRightMargin = "0.3"
            strHeaderDistance = "0.2"
            strFooterDistance = "0.2"
        Case 4 ' 7 x 10
            strPageWidth = "7"
            strPageHeight = "10"
            
            strTopMargin = "0.3"
            strBottomMargin = "0.3"
            strLeftMargin = "0.3"
            strRightMargin = "0.3"
            strHeaderDistance = "0.2"
            strFooterDistance = "0.2"
        Case 5 ' 8.25 x 11
            strPageWidth = "8.25"
            strPageHeight = "11"
            
            strTopMargin = "0.3"
            strBottomMargin = "0.3"
            strLeftMargin = "0.3"
            strRightMargin = "0.3"
            strHeaderDistance = "0.2"
            strFooterDistance = "0.2"
    End Select
        
    Selection.WholeStory
    
    ' If you don't need to set margins/headers/footers,
    ' then delete those lines below:
    With ActiveDocument.PageSetup
        .PageWidth = InchesToPoints(strPageWidth)
        .PageHeight = InchesToPoints(strPageHeight)
        
        .TopMargin = InchesToPoints(strTopMargin)
        .BottomMargin = InchesToPoints(strBottomMargin)
        .LeftMargin = InchesToPoints(strLeftMargin)
        .RightMargin = InchesToPoints(strRightMargin)
        .HeaderDistance = InchesToPoints(strHeaderDistance)
        .FooterDistance = InchesToPoints(strFooterDistance)
    End With
End Sub
Reply With Quote