How can I save all my graphs in a single A4 size pdf without my graphs being split over 2 pages?

[bruhyan]

Hi, I am relatively new to Excel VBA. Currently, I am trying to produce a PDF output where all my graphs in Excel are printed onto the pdf.
So far, I have tried using one of the codes posted on (Export excel graphs to horizontal PDF with VBA by Gabriela M and John RC). The code works well, however, as I have about 100+ graphs, a lot of graphs at the bottom of the page tends to be cut into half and be spread over 2 pages.

For my PDF output, I am trying to get a page with 4 graphs (Preferably in a 2x2 Landscape format) without my graphs being spread over/cut on 2 pages. May I check if anyone has any idea how to fix this, please? Thank you in advance!

Sub Graphs()

    Dim s As Workbook
    Dim ws As Worksheet, wsTemp As Worksheet
    Dim chrt As ChartObject
    Dim tp As Long
    Dim File As String
    Dim NewFileName As String
    Dim Path As String
    Dim i As Integer, nr As String



    Application.DisplayAlerts = False

    Application.ScreenUpdating = False

    'Define location of file
    SourcePath = "Source"

    'Name of excel file that contains the graphs:
    File = "File.xlsm"

    'Open the excel file:
    Set s = Workbooks.Open(SourcePath & "\" & File)

    'Name of the PDF I will create with the excel graphs:
    NewFileName = "X"

    'Name of the excel sheet I want to export to PDF:
    Set ws = s.Sheets("Graphs")

    Set wsTemp = s.Sheets.Add

    tp = 2
    ts = 5

   
    'Worksheets("Summary").Range("a1").CurrentRegion.Select
    'nr = Selection.Rows.Count
    'CurrentRegion.Unselect


    For i = 4 To 20
        Worksheets("Summary").Range("a2") = Worksheets("Summary").Cells(i, 1)
   
   
    'Copy-Pasting process:
        With wsTemp
            For Each chrt In ws.ChartObjects
                chrt.CopyPicture
                wsTemp.Paste
                Selection.Top = tp
                Selection.Left = ts
                tp = tp + Selection.Height + 50
            Next
       
        End With
    Next i
   
    wsTemp.ExportAsFixedFormat Type:=xlTypePDF, FileName:=NewFileName, Quality:=xlQualityStandard, _
       IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

    wsTemp.Delete

LetsContinue:
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue

End Sub