Embeded PDF Documents

[lizemi]

Good Day

I am looking for a way to do the following.
I have an excel sheet that has my calculations (Stock calculations) on and
On second sheet and embedded pdf document that is my source document (Physical stock sheet that is scanned).
I need a way to print these two sheets to pdf to create a new pdf document.
If I Print To PDF the embedded PDF document is in such bad quality it is not readable

Any Ideas

 

[John_w]

This is possible, but it requires quite a lot of code. There are 3 parts to your request:

1. Save the calculations sheet as a PDF. Record a macro whilst you save the sheet as a PDF and Excel will generate the VBA code, which simply calls the ExportAsFixedFormat method.

2. Extract and save the embedded PDF file(s). This can be done by saving the workbook as a .zip file and unzipping the oleObject<n>.bin file(s) in the "\xl\embeddings\" subfolder. Each .bin file is a container for another file format (including .pdf, .bmp, .jpg, etc.) with extra data bytes for Excel's use. The code must therefore determine whether a .bin file contains a PDF and, if so, save the PDF bytes as a .pdf file, ignoring the extra data bytes. All this is done by the following Extract_Embedded_PDFs function, which returns a string containing the full file names of the extracted PDFs separated by "|" characters.

Private Function Extract_Embedded_PDFs() As String

    Dim FSO As Object
    Dim ShellApp As Object
    Dim workingFolder As String
    Dim unzippedFolder As Variant
    Dim PDFsFolder As Variant
    Dim workbookZipFile As Variant
    Dim i As Long
    Dim oleObjectFileName As String, oleObjectFile As String
    Dim embeddedPDFfile As String

    'Extract embedded PDFs in this workbook and return a string containing the .pdf files separated by "|"
        
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set ShellApp = CreateObject("Shell.Application")
        
    'Define the working folder.  This will contain this workbook, saved as a .zip file, an Unzipped subfolder in which the embedded object .bin files will
    'be unzipped and a PDFs subfolder in which the embedded PDFs will be saved
    
    workingFolder = Environ("temp") & "\Workbook"
    
    unzippedFolder = workingFolder & "\Unzipped"    
    PDFsFolder = workingFolder & "\PDFs"    
    workbookZipFile = workingFolder & "\Workbook.zip"
    
    'Create the folders
    
    If FSO.FolderExists(workingFolder) Then FSO.DeleteFolder workingFolder
    FSO.CreateFolder workingFolder
    FSO.CreateFolder unzippedFolder
    FSO.CreateFolder PDFsFolder
    
    'Make copy of this workbook as a .zip file
    
    ActiveWorkbook.SaveCopyAs workbookZipFile
        
    'Unzip embedded objects (.bin files) and create .pdf files
    
    Extract_Embedded_PDFs = ""
    For i = 1 To ShellApp.Namespace(workbookZipFile).items.Count
        oleObjectFileName = "oleObject" & i & ".bin"
        ShellApp.Namespace(unzippedFolder).CopyHere ShellApp.Namespace(workbookZipFile).items.Item("xl\embeddings\" & oleObjectFileName)
        oleObjectFile = unzippedFolder & "\" & oleObjectFileName
        
        If Not FSO.FileExists(oleObjectFile) Then Exit For
        embeddedPDFfile = PDFsFolder & "\PDF_" & Format(i, "00") & ".pdf"
        If Create_PDF_From_Bin(oleObjectFile, embeddedPDFfile) Then
            Extract_Embedded_PDFs = Extract_Embedded_PDFs & embeddedPDFfile & "|"
        End If
    Next
    
    'Clean up
    
    FSO.DeleteFolder unzippedFolder
    FSO.DeleteFile workbookZipFile, True

End Function


Private Function Create_PDF_From_Bin(binFile As String, PDFfile As String) As Boolean

    Dim hFile As Integer
    Dim contents As String
    Dim PDF As String
    Dim i As Long, j As Long

    'Determine whether the specified .bin file contains a PDF and, if so, save the PDF bytes as the specified .pdf file and return True.  Otherwise return False
    
    Create_PDF_From_Bin = False
    
    hFile = FreeFile
    Open binFile For Binary Access Read As #hFile
    contents = String(LOF(hFile), vbNullChar)
    Get #hFile, , contents
    Close #hFile
    
    i = InStrB(1, contents, "%PDF")
    If i > 0 Then
        'This .bin file contains a PDF, so save the PDF bytes as a .pdf file
        j = InStrB(1, contents, "%%EOF" & vbLf)
        If j = 0 Then j = InStrB(1, contents, "%%EOF")
        PDF = MidB(contents, i, j - i + 12)
        Open PDFfile For Binary Access Write As #hFile
        Put #hFile, , PDF
        Close #hFile
        Create_PDF_From_Bin = True
    End If
    
End Function

3. To merge the PDF files generated by steps 1 and 2, run a command line tool such as PDFtk Server (specifically the cat command) from VBA - there should be example code on this forum. If you can't install 3rd party software, the PDF files could be merged by calling Word VBA to open the PDF files as editable Word documents and copy and paste both to a new Word document and save that as the merged PDF.

All 3 steps could be done in a single macro.