Results 1 to 5 of 5

Thread: Add in Fit to 1 Page on Print out
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Mar 2017
    Posts
    20
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Add in Fit to 1 Page on Print out

    Hi,

    I have the following code that I have copied from another sheet, however I need it to fit to one page, how do I update below please:

    Sheets("Butchery Order").Range("B1:K225").ExportAsFixedFormat _
    Type:=xlTypePDF, Filename:=strPrimalPlan, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, OpenAfterPublish:=True

  2. #2
    Board Regular
    Join Date
    Feb 2002
    Posts
    3,206
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Add in Fit to 1 Page on Print out

    Hi Ibb01978

    Does this do what you require, test and copy of your workbook first
    Pagebreak will reflect the changes

    Code:
    Sub myFIT_TO_ONE_Page_PRINT()
    
    Dim myZoom As Boolean
    Dim iWidth As Long
    Dim iHeight As Long
    Dim TARGET_WS As Worksheet
    
    myZoom = False
    iWidth = 1
    iHeight = 1
    
    
    Set TARGET_WS = ActiveSheet
     With traget_WS.PageSetup
    
         .Zoom = False
         .FitToPagesWide = 1
         .FitToPagesTall = 1
    End With
    
    
    theEND:
    Set TARGET_WS = Nothing
    Exit Sub
    
    End Sub
    Free Excel based Web Toolbar available here.

    Jack in the UK
    J & R Excel Solutions
    "making Excel work for you"

  3. #3
    New Member
    Join Date
    Mar 2017
    Posts
    20
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Add in Fit to 1 Page on Print out

    I think I actually just need the selection to reduce to fit 1 page in the PDF? is that possible?

  4. #4
    Board Regular
    Join Date
    Feb 2002
    Posts
    3,206
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Add in Fit to 1 Page on Print out

    Untested maybe closer to what you require
    Regards

    jiuk

    Code:
     Const MyTitle As String = "Select Print Area"
     Const Message As String = "Please select a RANGE To PRINT"
     '# jiuk
     
    Sub myPRINT_ONE_PAGE()
    
    Dim myZoom As Boolean
    Dim iWidth As Long
    Dim iHeight As Long
    Dim TARGET_WS As Worksheet
    Dim myPRINT_RANGE As Range
    
    myZoom = False
    iWidth = 1
    iHeight = 1
    
    Set myTarget_Worksheet = ActiveSheet
    
    On Error Resume Next
      
    Set myPRINT_RANGE = Application.InputBox(Message, Title, , , , , , 8)
    
     On Error GoTo 0
     If myPRINT_RANGE Is Nothing Then
     MsgBox "Code will abort - nothing selected"
     Exit Sub
     End If
    
     With myTarget_Worksheet.PageSetup
     
     .Zoom = False
     .PrintArea = myPRINT_RANGE.Address
     .CenterHorizontally = True
     .CenterVertically = False
     .PrintTitleRows = ("$A$1:$k$1") ' jiuk - edit or omit as required
     .Orientation = xlPortrait ' jiuk - change as required
     .FitToPagesWide = iWidth
     .FitToPagesTall = iHeight
        
     End With
     
    myTarget_Worksheet.PrintOut
    
    theEND:
    Set myTarget_Worksheet = Nothing
    
     End Sub
    Free Excel based Web Toolbar available here.

    Jack in the UK
    J & R Excel Solutions
    "making Excel work for you"

  5. #5
    Board Regular
    Join Date
    Feb 2002
    Posts
    3,206
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Add in Fit to 1 Page on Print out

    - or -

    jiuk
    Code:
     Const MyTitle As String = "Select Print Area"
     Const Message As String = "Please select a RANGE To PRINT"
     '# jiuk
     
    Sub myPRINT_ONE_PAGE()
    
    Dim myZoom As Boolean
    Dim iWidth As Long
    Dim iHeight As Long
    Dim TARGET_WS As Worksheet
    Dim myPRINT_RANGE As Range
    
    myZoom = False
    iWidth = 1
    iHeight = 1
    
    Set myTarget_Worksheet = ActiveSheet
    
    On Error Resume Next
      
    'Set myPRINT_RANGE = Application.InputBox(Message, Title, , , , , , 8)
    '# B1:K225
    Set myPRINT_RANGE = Range("B1:K225")
    
     On Error GoTo 0
     If myPRINT_RANGE Is Nothing Then
     MsgBox "Code will abort - nothing selected"
     Exit Sub
     End If
    
     With myTarget_Worksheet.PageSetup
     
     .Zoom = False
     .PrintArea = myPRINT_RANGE.Address
     .CenterHorizontally = True
     .CenterVertically = False
     .PrintTitleRows = ("$A$1:$k$1") ' jiuk - edit or omit as required
     .Orientation = xlPortrait ' jiuk - change as required
     .FitToPagesWide = iWidth
     .FitToPagesTall = iHeight
        
     End With
     
    myTarget_Worksheet.PrintOut
    
    theEND:
    Set myTarget_Worksheet = Nothing
    
     End Sub
    Free Excel based Web Toolbar available here.

    Jack in the UK
    J & R Excel Solutions
    "making Excel work for you"

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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