Add in Fit to 1 Page on Print out

Ibbo1978

New Member
Joined
Mar 6, 2017
Messages
20
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
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
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
 
Upvote 0
I think I actually just need the selection to reduce to fit 1 page in the PDF? is that possible?
 
Upvote 0
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
 
Upvote 0
- 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
 
Upvote 0

Forum statistics

Threads
1,213,520
Messages
6,114,099
Members
448,548
Latest member
harryls

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top