Save as PDF Problem

[rodl66]

Hello Excel Gurus!

I have a project that is giving me a fit in that I am using the same code for two different tabs to save only the cells that have data in them as a PDF and one works fine, while the other does not. The problem child breaks up the saved cells into two pages, where the other one doesn't.

I've included a screenshot of the cells that are being saved and the PDF that I had to save as two separate image files

. Here is my VBA code, which was my fourth different iteration of it, each time trying a different way, but ending with the same results:

Sub SaveMPFChronLogToPDF()

Dim ws As Worksheet
Dim rng As Range
Dim fileName As String

' Set the worksheet
Set ws = ThisWorkbook.Sheets("Chron Log")

' Set the reange to save (columns A and B that contain data)
Set rng = ws.Range("A:B").SpecialCells(xlCellTypeConstants)

' Check if there is data in the range
If WorksheetFunction.CountA(rng) = 0 Then
MsgBox "No data to save!", vbExclamation
Exit Sub
End If

' Create the filename with date format "ddmmmyyyy"
fileName = "C:\Trackers\Logs\Chron Log\MPF Chron Logs\ " & "MPF Chron Log " & Format(Date, "ddmmmyyyy") & ".pdf"

' Set the print area to fit the data
With ws.PageSetup
.PaperSize = xlPaperLetter
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
End With


' Save the range as PDF
rng.ExportAsFixedFormat Type:=xlTypePDF, fileName:=fileName, Quality:=xlQualityStandard

' Clear the print area
ws.PageSetup.PrintArea = ""

MsgBox "PDF saved successfully!", vbInformation

End Sub

Any assistance/advice is appreciated.

Thank you!

 

[Jimmypop]

Hi there

I tested your code and could not seem to find the issue... Maybe someone else can pick it up.

I have however changed it a bit to something that does work and you can use this if you want to... Thanks

Sub SaveMPFChronLogToPDF()
    Dim ws          As Worksheet
    Dim rng         As Range
    Dim fileName    As String
    Dim targetSheet As Worksheet
    Set targetSheet = ThisWorkbook.Worksheets("Chron Log")
    Dim lastRow     As Long
    lastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
    Dim lastColumn  As Long
    lastColumn = targetSheet.Cells(1, targetSheet.Columns.Count).End(xlToRight).Column
    Dim printRange  As Range
    Set printRange = targetSheet.Range("A1", targetSheet.Cells(lastRow, lastColumn))
    targetSheet.PageSetup.PrintArea = printRange.Address
    
    ' Set the reange to save (columns A and B that contain data)
    Set rng = Range(Worksheets("Chron Log").PageSetup.PrintArea)
    
    ' Check if there is data in the range
    If WorksheetFunction.CountA(rng) = 0 Then
        MsgBox "No data To save!", vbExclamation
        Exit Sub
    End If
    
    ' Create the filename with date format "ddmmmyyyy"
    fileName = "C:\Trackers\Logs\Chron Log\MPF Chron Logs\ " & "MPF Chron Log " & Format(Date, "ddmmmyyyy") & ".pdf"
    
    ' Save the range as PDF
    rng.ExportAsFixedFormat Type:=xlTypePDF, fileName:=fileName, Quality:=xlQualityStandard
    
    ' Clear the print area
    
    ActiveSheet.PageSetup.PrintArea = ""
    
    MsgBox "PDF saved successfully!", vbInformation
End Sub

 

[rodl66]

Hi there

I tested your code and could not seem to find the issue... Maybe someone else can pick it up.

I have however changed it a bit to something that does work and you can use this if you want to... Thanks

Sub SaveMPFChronLogToPDF()
    Dim ws          As Worksheet
    Dim rng         As Range
    Dim fileName    As String
    Dim targetSheet As Worksheet
    Set targetSheet = ThisWorkbook.Worksheets("Chron Log")
    Dim lastRow     As Long
    lastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
    Dim lastColumn  As Long
    lastColumn = targetSheet.Cells(1, targetSheet.Columns.Count).End(xlToRight).Column
    Dim printRange  As Range
    Set printRange = targetSheet.Range("A1", targetSheet.Cells(lastRow, lastColumn))
    targetSheet.PageSetup.PrintArea = printRange.Address
   
    ' Set the reange to save (columns A and B that contain data)
    Set rng = Range(Worksheets("Chron Log").PageSetup.PrintArea)
   
    ' Check if there is data in the range
    If WorksheetFunction.CountA(rng) = 0 Then
        MsgBox "No data To save!", vbExclamation
        Exit Sub
    End If
   
    ' Create the filename with date format "ddmmmyyyy"
    fileName = "C:\Trackers\Logs\Chron Log\MPF Chron Logs\ " & "MPF Chron Log " & Format(Date, "ddmmmyyyy") & ".pdf"
   
    ' Save the range as PDF
    rng.ExportAsFixedFormat Type:=xlTypePDF, fileName:=fileName, Quality:=xlQualityStandard
   
    ' Clear the print area
   
    ActiveSheet.PageSetup.PrintArea = ""
   
    MsgBox "PDF saved successfully!", vbInformation
End Sub

Jimmypop,

Thank you for the reply, it is appreciated. I have buttons and text boxes on this sheet that I don't want to be captured in the PDF. I need only cells with data in rows A and B to be captured. This is where I ran into problems where the row 4 on shows up on a separate page from rows 1-3. I do have column B set to wrap text, not sure if that has something to do with it or not. I've added a screenshot for reference.

Thank you!

 

[Jimmypop]

Hi there

I have had a look and still also struggling... Maybe someone else has suggestion. I think the problem is lying with your page setup somewhere.

 

[gior]

Hi, if only 2 columns are needed in PDF please try replacement

lastColumn = targetSheet.Cells(1, targetSheet.Columns.Count).End(xlToRight).Column

with

lastColumn = 2

 

[rodl66]

Hi, if only 2 columns are needed in PDF please try replacement

lastColumn = targetSheet.Cells(1, targetSheet.Columns.Count).End(xlToRight).Column

with

lastColumn = 2

Gior,

That worked perfectly, thank you very much!!