VBA Issues - Multiple Sheets to PDF

[Jnielsen]

I have tried several different types of code to complete this and I can't seem to make it work. Here is what I am trying to do:

I will have several different excel files that have multiple tabs. Within each workbook there are two tabs I would like to grab. Within the two tabs there are specific ranges I need to grab. When I grab the info from these two tabs I need to place each sheet into the same PDF file (each sheet needs to be on a separate PDF page. And then save the PDF File

I have tried three or four different ways to get this accomplished but haven't had any luck. The excel file I am trying to practice on is named ServicerStatus-SST and the two sheet names are Servicer Recon and Delq Summary. We can say the ranges are A1:J15.


Anyone that could help me with this would be a rockstar! Any thing else I need to provide you please let me know.

Flustered!!

Jason

 

[AlphaFrog]

Try something like this...

[color=darkblue]With[/color] Workbooks("ServicerStatus-SST.xlsx")
    
    [color=darkblue]With[/color] .Worksheets.Add    [color=green]'new Temp worksheet[/color]
    
        [color=green]'copy two ranges separated by pagebreak[/color]
        .Parent.Sheets("Servicer Recon").Range("A1:J15").Copy Destination:=.Range("A1")
        .HPageBreaks.Add Before:=Range("A16")
        .Parent.Sheets("Delq Summary").Range("A1:J15").Copy Destination:=.Range("A16")
        
        .ExportAsFixedFormat Type:=xlTypePDF, _
                             Filename:="C:\Temp\Test.pdf", _
                             Quality:=xlQualityStandard, _
                             IncludeDocProperties:=True, _
                             IgnorePrintAreas:=False, _
                             OpenAfterPublish:=[color=darkblue]False[/color]
                             
        [color=green]'delete temp worksheet[/color]
        Application.DisplayAlerts = [color=darkblue]False[/color]
        .Delete
        Application.DisplayAlerts = [color=darkblue]True[/color]
        
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
[color=darkblue]End[/color] [color=darkblue]With[/color]

 

[Jnielsen]

Thank you Alpha. That worked perfectly. I was making it to difficult. Just need to do a little sizing and I am good to go.

I primarily code in SAS right now and have forgotten a lot of the syntax in VB.

Thanks again

 

[Jnielsen]

One final question.

I am trying to get one of my charts to fit on one page in PDF. It is too wide. I tried to add this to my code to shrink it to one page. It worked, however it is now putting both charts on the same PDF page??
Thoughts?

With ActiveSheet.PageSetup
.Zoom = False
.FitToPagesWide = 1
End With

 

[Jnielsen]

Here is my entire VBA Code. just in case


Sub PDF_Create()
Application.Workbooks.Open "C:\Users\jnielsen\Desktop\ServicerStatus-SST.xlsx", UpdateLinks:=False
With Workbooks("ServicerStatus-SST.xlsx")

With .Worksheets.Add 'new Temp worksheet

'copy two ranges separated by pagebreak
.Parent.Sheets("Servicer Recon").Range("A1:J15").Copy Destination:=.Range("A1")
Columns("A:A").ColumnWidth = 21.71
Columns("A:A").ColumnWidth = 30.14
Columns("A:A").ColumnWidth = 34.43
Columns("B:B").EntireColumn.AutoFit
Cells.Select
Cells.EntireRow.AutoFit
Selection.ColumnWidth = 38.14
Range("B2").Select
Columns("B:B").EntireColumn.AutoFit
Columns("A:A").ColumnWidth = 46.57
ActiveWindow.View = xlPageBreakPreview 'This may get you closer
.ResetAllPageBreaks 'Supposed to reset page breaks
With ActiveSheet.PageSetup
.Zoom = False
.FitToPagesWide = 1
End With
.HPageBreaks.Add Before:=Rows(16)
.Parent.Sheets("Delq Summary").Range("A1:J15").Copy Destination:=.Range("A16")
Columns("A:J").ColumnWidth = 17
With ActiveSheet.PageSetup
.Zoom = False
.FitToPagesWide = 1
End With

.ExportAsFixedFormat Type:=xlTypePDF, _
FileName:="C:\Temp\Test.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True

'delete temp worksheet
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True

End With

End With
ActiveWorkbook.Close savechanges:=False
End Sub

 

[AlphaFrog]

I don't know how to make it both autofit and keep the horizontal pagebreaks, but if you know how much to zoom it down by a fixed amount, that could be set in the code.

[COLOR=darkblue]Sub[/COLOR] PDF_Create()
    
    [COLOR=darkblue]With[/COLOR] Application.Workbooks.Open("C:\Users\jnielsen\Desktop\ServicerStatus-SST.xlsx", UpdateLinks:=False)[COLOR=green][/COLOR]
    
        [COLOR=darkblue]With[/COLOR] .Worksheets.Add    [COLOR=green]'new Temp worksheet[/COLOR]
    
            [COLOR=green]'copy two ranges separated by pagebreak[/COLOR]
            .Parent.Sheets("Servicer Recon").Range("A1:J15").Copy Destination:=.Range("A1")
            .HPageBreaks.Add Before:=Rows(16)
            .Parent.Sheets("Delq Summary").Range("A1:J15").Copy Destination:=.Range("A16")
            
            .Rows.AutoFit
            .Columns("A:J").ColumnWidth = 17
            
            .PageSetup.Zoom = [COLOR=#ff0000]50[/COLOR]    [COLOR=green]'print zoom percent[/COLOR]
    
            .ExportAsFixedFormat Type:=xlTypePDF, _
                                 Filename:="C:\Temp\Test.pdf", _
                                 Quality:=xlQualityStandard, _
                                 IncludeDocProperties:=True, _
                                 IgnorePrintAreas:=False, _
                                 OpenAfterPublish:=[COLOR=darkblue]True[/COLOR]
    
            [COLOR=green]'delete temp worksheet[/COLOR]
            Application.DisplayAlerts = [COLOR=darkblue]False[/COLOR]
            .Delete
            Application.DisplayAlerts = [COLOR=darkblue]True[/COLOR]
    
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
        .Close SaveChanges:=[COLOR=darkblue]False[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]