Print to PDF VBA formatting issues

[Tosborn]

Hi all,

I have some VBA to print out a large document for all regional manager & their stores to one pdf file.

I have set the page setup as landscape and fit to one page for each page but it doesn’t work when the pdf is created. Each page comes out as portrait and not on the one page.
Any help is appreciated.

Sub PDFandEmail()

'To set page breaks on all worksheets, ignoring erros

Dim ws As Worksheet
Worksheets(1).Activate
    For Each ws In ThisWorkbook.Worksheets
    On Error Resume Next

        Dim a As Integer
        a = ActiveSheet.Index + 1
        If a > Sheets.Count Then a = 1
        Sheets(a).Activate
 
        ActiveWindow.View = xlPageBreakPreview
        ActiveSheet.ResetAllPageBreaks
        ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
            
            With ActiveSheet.PageSetup
            
                .Zoom = False
                .FitToPagesWide = 1
                .FitToPagesTall = 1
                .Orientation = xlLandscape
     
            End With

        
        
Next ws

'Go to the last sheet and set variables

Sheets("List").Select

    Dim sheetArray() As String
    Dim rcell As Range
    Dim i As Integer
    Dim wksAllSheets As Variant
    Dim wksSheet1 As Worksheet
    Dim strFilename As String, strFilepath As String
    Dim r3 As Range
    Dim x As Integer
    Dim z As Integer ' Number of Stores in Row
    Dim y As Variant
    Dim c As Variant
    Dim wks As Worksheet
    Dim lastCell As Long
    Dim oApp As Object
    Dim oMail As Object
    
   
        i = 0
        x = 5
            

'Select sheets for creation of PDFs
             
    For Each rcell In Range("e5:q5")
    
    z = Cells(3, x).Value
    
        If rcell.Value <> "" Then
        
             For Each c In Range(Cells(5, x), Cells(z, x)).Cells
                    ReDim Preserve sheetArray(0 To i)
                    sheetArray(i) = c.Value
                    i = i + 1
             Next c
             
            strFilepath = "G:\Finance\SunV5.3.1\Store P&L's\RMemails\"
            strFilename = rcell
       
            Sheets(sheetArray).Select

            'Export as pdf

            With ActiveSheet
            .ExportAsFixedFormat _
              Type:=xlTypePDF, _
              Filename:=strFilepath & strFilename, _
              Quality:=xlQualityStandard, _
              IncludeDocProperties:=True, _
              IgnorePrintAreas:=False, _
              OpenAfterPublish:=False
              
              End With
            
            'clear integers
            
            x = x + 1
            i = 0
            Set c = Nothing
            
                'Email P&L to RM
            
                        Set oApp = CreateObject("Outlook.Application")
                        Set oMail = oApp.CreateItem(0) 'olMailItem = 0
                            
                            With oMail
                            
                                'User input To property
                                .To = rcell
                                'User input CC property
                                .CC = "Tim osborn"
                                .Subject = "Region Store P&Ls"
                                'Hard code Body property
                                .Body = "Please find your region's store P&Ls for the prior period attached. Kind regards, Timothy Osborn."
                                'Set attachment
                                .Attachments.Add strFilepath & strFilename & ".pdf"
                                '.Send
                                'Display it
                                .Display
                                End With
                 
              End If
        
        ActiveWorkbook.Sheets(1).Select
        Sheets(Sheets.Count).Select
        
        'Application.Wait Now + #12:00:03 AM# - don't think we need this
        
    Next rcell
    
MsgBox "PDF Printing & Email Creation Complete"

End Sub

Thanks,
Tim