Dynamically Adjust Print Size with VBA Based on Print Zoom %?

I use an excel worksheet as a template. Information is imported into the template and when I am done I will print a pdf copy via VBA. I then reset the template, import different information and repeat the process. This goes on many times per day. I set up my template to print 1 page wide by 1 page tall as the default. The problem is that sometimes there are too many rows in the template to fit comfortably on one page and the printout is too small to read. If I set my template to print 1 page wide as the default then sometimes a page that is just a little too big will print on two pages when it could have comfortably fit on one.

Is there a way in VBA to check if printing the template 1 page wide by 1 page tall will zoom below 85% and if so, then print to 1 page wide only?

Please provide all code as I am new to VBA but learning fast! Thank you!

Thanks for the quick reply JLGWhiz. I have a "Publish" button that I press which saves the template to pdf and attaches it to an email. A print preview also opens up to double check everything before I hit send on my email. I was hoping to automate the sizing in VBA (per my original post) so I don't have to "Easter egg" around with the print sizing (see what I did there being Easter and all). Would you or someone else know how to do this in VBA?

Thanks again for your response. I appreciate it.

Hi there,

See if the following code does what you need:

Option Explicit


Sub SetZoom()

    Const iMINIMUM_ZOOM As Integer = 85

    Dim wks As Worksheet

    Set wks = ActiveSheet

    With wks.PageSetup

        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .Zoom = False

        Application.ExecuteExcel4Macro "PAGE.SETUP(,,,,,,,,,,,,{1,#N/A})"
        Application.ExecuteExcel4Macro "PAGE.SETUP(,,,,,,,,,,,,{#N/A,#N/A})"

        If .Zoom < iMINIMUM_ZOOM Then
            .Zoom = False
        End If

    End With

End Sub

Acknowledgement to Andy Pope for the Excel4 macro part of the code.


Hope this helps - please let me know how you get on.

Regards,

Greg M

Thanks Greg M. I have to admit I am a newbie. I incorporated your code with what I already have (see below). The Option Explicit gave me an error even though I put it at the very top (above Private Sub Publish_Click(). I took it out just to see what would happen.

When I click the Publish button the pdf will save but the pdf print zoom size does not seem to dynamically adjust. It is always 1 page wide. This is fine for very long pages since it needs to be on more than one page (otherwise it is too small to see) but for ones that are just over I would like to squeeze them into a single pdf page as long as the zoom is not below 85. Would you please take a peek at the code below and let me know what may be the problem? I greatly appreciate your help!


Private Sub Publish_Click()

'Perform Spellcheck
Sheets("Rebalancer").CheckSpelling

'Create pdf file name and save location
Dim filenamemacro As String
Dim outlookapp As Object
Dim OutlookMessage As Object
Path = CreateObject("WScript.Shell").specialfolders("Desktop")
filenamemacro = Path & "\" & Sheets("Rebalancer").Range("A1") & Format$(Date, " mm-dd-yyyy")

'Determine print page size

Const iMINIMUM_ZOOM As Integer = 85
Dim wks As Worksheet
Set wks = ActiveSheet

With wks.PageSetup

.FitToPagesWide = 1
.FitToPagesTall = 1
.Zoom = False

Application.ExecuteExcel4Macro "PAGE.SETUP(,,,,,,,,,,,,{1,#N/A})"
Application.ExecuteExcel4Macro "PAGE.SETUP(,,,,,,,,,,,,{#N/A,#N/A})"

If .Zoom < iMINIMUM_ZOOM Then
.FitToPagesWide = 1
.FitToPagesTall = False
.Zoom = False
End If

End With

'Save to pdf

ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=filenamemacro, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True

End Sub