Save file as pdf and split it per page and file name

[ibbara]

Hello,

Can anyone help me, I am sending notices to multiple company, my excel sheet consist of multiple notices, I want to save it per page as pdf and split it with company name

Thank you

 

[John_w]

Does the sheet have page breaks to separate each company? If so, which cell on each page contains the company name? For example, each company name is in column A of the first row of each page.

 

[ibbara]

Yes it has a page brake, the company name has merged cell, i've attached the sample notice that i'm using. It has header and footer. Page brake end in the total amount.

Thank you

 

[John_w]

You haven't answered my question about which cell on each page contains the company name for that page. Therefore this code can't name each PDF with the company name and instead saves them as "Page 1.pdf", "Page 2.pdf", etc. in the folder path specified in the savePDFsInFolder string. This code reads from the active sheet.

Public Sub Save_Sheet_Pages_As_PDFs()

    Dim saveSheet As Worksheet
    Dim lastRow As Long
    Dim page As Long, nextPageStartRow As Long
    Dim pageRange As Range
    Dim savePDFsInFolder As String
    Dim CompanyName As String
    
    savePDFsInFolder = "C:\path\to\folder\" '<--------- CHANGE THIS
    If Right(savePDFsInFolder, 1) <> "\" Then savePDFsInFolder = savePDFsInFolder & "\"
    
    Application.ScreenUpdating = False
            
    Set saveSheet = ActiveSheet
    
    With saveSheet
        .Activate
        ActiveWindow.View = xlPageBreakPreview

        lastRow = .UsedRange.Rows.Count
        nextPageStartRow = 1
        
        For page = 1 To .HPageBreaks.Count + 1
            'Define the range of rows for this page
            If page <= .HPageBreaks.Count Then
                'This page ends with a page break, so the end row is the row number before the page break
                Set pageRange = .Rows(nextPageStartRow & ":" & .HPageBreaks(page).Location.Row - 1)
                nextPageStartRow = .HPageBreaks(page).Location.Row
            Else
                'The last page doesn't end with a page break, so the end row is the last row of the used range
                Set pageRange = .Rows(nextPageStartRow & ":" & lastRow)
                nextPageStartRow = lastRow + 1
            End If
            'Read the company name from this page's first row column A
            'CompanyName = saveSheet.Cells(pageRange.Row, "A").Value  'Don't know which cell contains company name
            CompanyName = "Page " & page
            pageRange.ExportAsFixedFormat Type:=xlTypePDF, Filename:=savePDFsInFolder & CompanyName & ".pdf", _
                    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        Next
        
        ActiveWindow.View = xlNormalView
        
    End With
    
    Application.ScreenUpdating = True
    
    MsgBox "PDF pages saved in " & savePDFsInFolder
    
End Sub

 

[ibbara]

Hi sir,

Sorry for the late reply. Thank you for the codes. I thought i had attached the large file. Attached is the sample statement we send. Company name has merged cell from "a" to "d".

 

[ibbara]

Hi sir john,

I tried the code it went well, but my problem is that the last page to save as pdf. It shows a pop up message "publishing" it takes too long to finish the loading.

Thank you

 

[John_w]

As a temporary change to help diagnose the issue with the last page, delete the two Application.ScreenUpdating lines and add these 2 lines immediately before the ExportAsFixedFormat line:

            Application.Goto .Cells(pageRange.Row + pageRange.Rows.Count - 1, 1)
            MsgBox "Page: " & page & vbCrLf & "Rows: " & pageRange.Address, vbInformation

That code scrolls to the last cell of each page and displays the page number and its row numbers. This lets you see whether or not the code is using the correct row numbers for each page.

 

[ibbara]

Hi sir john,

I think i'm gonna the use the previous code sir. Just gonna add another blank page and cancel publishing message. The new code is saving per page by clicking a pop up message.

Thank you for helping me.

Can you please add a code that renaming it per pdf page per company name?. This code is renaming it per page numbers.

Thank you have a nice day sir john!

 

[John_w]

Just gonna add another blank page and cancel publishing message.

In that case the For ... Next loop is simpler and I've changed it in the macro below.

The new code is saving per page by clicking a pop up message.

As I said in my previous post, that's only to help investigate the issue with the last page, but since you haven't told me whether the row numbers it displays for the last page are correct or not, I don't know how the code should be changed to fix the issue.

Can you please add a code that renaming it per pdf page per company name?. This code is renaming it per page numbers.

OK, this new macro looks for the cell on each page containing the exact string "Employer ID No." and reads the company name from column A on the same row (that's where I think the company name is, according to your screenshots). If "Employer ID No." isn't found the macro saves the PDF for that page as "Page n", as before.

Public Sub Save_Sheet_Pages_As_PDFs2()

    Dim saveSheet As Worksheet
    Dim lastRow As Long
    Dim page As Long, nextPageStartRow As Long
    Dim pageRange As Range
    Dim savePDFsInFolder As String
    Dim EmployerIDcell As Range
    Dim CompanyName As String
    
    savePDFsInFolder = "C:\path\to\folder\" '<--------- CHANGE THIS
    If Right(savePDFsInFolder, 1) <> "\" Then savePDFsInFolder = savePDFsInFolder & "\"
    
    Application.ScreenUpdating = False
            
    Set saveSheet = ActiveSheet
    
    With saveSheet
        .Activate
        ActiveWindow.View = xlPageBreakPreview

        lastRow = .UsedRange.Rows.Count
        nextPageStartRow = 1
        
        For page = 1 To .HPageBreaks.Count
            'Define the range of rows for this page
            Set pageRange = .Rows(nextPageStartRow & ":" & .HPageBreaks(page).Location.Row - 1)
            nextPageStartRow = .HPageBreaks(page).Location.Row
            'Find the "Employer ID No." cell on this page
            Set EmployerIDcell = pageRange.Find("Employer ID No.", After:=.Cells(pageRange.Row, 1))
            If Not EmployerIDcell Is Nothing Then
                'Cell found, so read the company name from column A on the same row
                CompanyName = .Cells(EmployerIDcell.Row, "A").Value
            Else
                'Cell not found, so use "Page n" as the PDF name
                CompanyName = "Page " & page
            End If
            pageRange.ExportAsFixedFormat Type:=xlTypePDF, Filename:=savePDFsInFolder & CompanyName & ".pdf", _
                    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        Next
        
        ActiveWindow.View = xlNormalView
        
    End With
    
    Application.ScreenUpdating = True
    
    MsgBox "PDF pages saved in " & savePDFsInFolder
    
End Sub