How to export excel sheet with high fidelity images as pdf and retain image quality, using VBA

[jimedmunds]

Excel for Office 365, and Acrobat DC (paid version). I can create high resolution pdf's using the Acrobat driver (accessed either via the 'Export' function on the 'File' menu, or via the Acrobat menu item). However, I can't find any way to access these functions using VBA (needed as this is a batching tool used to generate pdf's from hundreds of workbooks). I need super-high resolution (in the Adobe pdf print settings I have bicubic downsampling to 2400-6000 pixels per inch).

The easy way is to use the microsoft pdf drivers accessed via 'ExportAsFixedFormat ' action. However this downsamples images so is useless for my purposes.

As the menu system has the function i need ('File'/'Export'/'Create Adobe PDF' - thumbnail screenshot below) I figure there must be some way to access this via code, but I've done a lot of google searching and not found the answer. Any suggestions Mr Excel team?

 

[Zot]

I have never tried this but it looks like your default printer is not the Adobe.

Maybe you can set the default printer to direct to Adobe using VBA. See example here. Although this was talking about Word, but it should work on Excel too.

Word Macro: Export high quality PDF (with images)

I import images into a Word file and export/save everything as a PDF file afterwards using this code: ActiveDocument.SaveAs _ filename:=pdfpath, _ FileFormat:=wdFormatPDF, _ LockCommen...

stackoverflow.com

To make thing easy, below is the code I extracted from there and the Sub Test() that successfully extracted all the printer list in my PC

Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modListPrinters
' By Chip Pearson, chip@cpearson.com  www.cpearson.com
' Created 22-Sept-2012
' This provides a function named GetPrinterFullNames that
' returns a String array, each element of which is the name
' of a printer installed on the machine.
' Source: http://www.cpearson.com/excel/GetPrinters.aspx
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKCU = HKEY_CURRENT_USER
Private Const KEY_QUERY_VALUE = &H1&
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const ERROR_MORE_DATA = 234

#If VBA7 Then ' VBA7 for 64bit
    Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32" _
        Alias "RegOpenKeyExA" ( _
        ByVal HKey As Long, _
        ByVal lpSubKey As String, _
        ByVal ulOptions As Long, _
        ByVal samDesired As Long, _
        phkResult As Long) As Long

    Private Declare PtrSafe Function RegEnumValue Lib "advapi32.dll" _
        Alias "RegEnumValueA" ( _
        ByVal HKey As Long, _
        ByVal dwIndex As Long, _
        ByVal lpValueName As String, _
        lpcbValueName As Long, _
        ByVal lpReserved As Long, _
        lpType As Long, _
        lpData As Byte, _
        lpcbData As Long) As Long

    Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" ( _
        ByVal HKey As Long) As Long
#Else
    Private Declare Function RegOpenKeyEx Lib "advapi32" _
        Alias "RegOpenKeyExA" ( _
        ByVal HKey As Long, _
        ByVal lpSubKey As String, _
        ByVal ulOptions As Long, _
        ByVal samDesired As Long, _
        phkResult As Long) As Long

    Private Declare Function RegEnumValue Lib "advapi32.dll" _
        Alias "RegEnumValueA" ( _
        ByVal HKey As Long, _
        ByVal dwIndex As Long, _
        ByVal lpValueName As String, _
        lpcbValueName As Long, _
        ByVal lpReserved As Long, _
        lpType As Long, _
        lpData As Byte, _
        lpcbData As Long) As Long

    Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
        ByVal HKey As Long) As Long
#End If

Public Function GetPrinterFullNames() As String()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GetPrinterFullNames
' By Chip Pearson, chip@cpearson.com, www.cpearson.com
' Returns an array of printer names, where each printer name
' is the device name followed by the port name. The value can
' be used to assign a printer to the ActivePrinter property of
' the Application object. Note that setting the ActivePrinter
' changes the default printer for Excel but does not change
' the Windows default printer.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Printers() As String ' array of names to be returned
Dim PNdx As Long    ' index into Printers()
Dim HKey As Long    ' registry key handle
Dim Res As Long     ' result of API calls
Dim Ndx As Long     ' index for RegEnumValue
Dim ValueName As String ' name of each value in the printer key
Dim ValueNameLen As Long    ' length of ValueName
Dim DataType As Long        ' registry value data type
Dim ValueValue() As Byte    ' byte array of registry value value
Dim ValueValueS As String   ' ValueValue converted to String
Dim CommaPos As Long        ' position of comma character in ValueValue
Dim ColonPos As Long        ' position of colon character in ValueValue
Dim M As Long               ' string index

' registry key in HCKU listing printers
Const PRINTER_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Devices"

PNdx = 0
Ndx = 0
' assume printer name is less than 256 characters
ValueName = String$(256, Chr(0))
ValueNameLen = 255
' assume the port name is less than 1000 characters
ReDim ValueValue(0 To 999)
' assume there are less than 1000 printers installed
ReDim Printers(1 To 1000)

' open the key whose values enumerate installed printers
Res = RegOpenKeyEx(HKCU, PRINTER_KEY, 0&, _
    KEY_QUERY_VALUE, HKey)
' start enumeration loop of printers
Res = RegEnumValue(HKey, Ndx, ValueName, _
    ValueNameLen, 0&, DataType, ValueValue(0), 1000)
' loop until all values have been enumerated
Do Until Res = ERROR_NO_MORE_ITEMS
    M = InStr(1, ValueName, Chr(0))
    If M > 1 Then
        ' clean up the ValueName
        ValueName = Left(ValueName, M - 1)
    End If
    ' find position of a comma and colon in the port name
    CommaPos = InStr(1, ValueValue, ",")
    ColonPos = InStr(1, ValueValue, ":")
    ' ValueValue byte array to ValueValueS string
    On Error Resume Next
    ValueValueS = Mid(ValueValue, CommaPos + 1, ColonPos - CommaPos)
    On Error GoTo 0
    ' next slot in Printers
    PNdx = PNdx + 1
    ' Printers(PNdx) = ValueName & " on " & ValueValueS
    ' ^ This would return e.g. "Microsoft Print to PDF on Ne02:", I only want the actual name:
    Printers(PNdx) = ValueName

    ' reset some variables
    ValueName = String(255, Chr(0))
    ValueNameLen = 255
    ReDim ValueValue(0 To 999)
    ValueValueS = vbNullString
    ' tell RegEnumValue to get the next registry value
    Ndx = Ndx + 1
    ' get the next printer
    Res = RegEnumValue(HKey, Ndx, ValueName, ValueNameLen, _
        0&, DataType, ValueValue(0), 1000)
    ' test for error
    If (Res <> 0) And (Res <> ERROR_MORE_DATA) Then
        Exit Do
    End If
Loop
' shrink Printers down to used size
ReDim Preserve Printers(1 To PNdx)
Res = RegCloseKey(HKey)
' Return the result array
GetPrinterFullNames = Printers
End Function

Sub Test()

Dim Printers() As String
Dim N As Long
        Dim S As String
        Printers = GetPrinterFullNames()
        For N = LBound(Printers) To UBound(Printers)
            S = S & Printers(N) & vbNewLine
        Next N
        Debug.Print S
    End Sub

 

[John_w]

Excel for Office 365, and Acrobat DC (paid version). I can create high resolution pdf's using the Acrobat driver (accessed either via the 'Export' function on the 'File' menu, or via the Acrobat menu item). However, I can't find any way to access these functions using VBA (needed as this is a batching tool used to generate pdf's from hundreds of workbooks). I need super-high resolution (in the Adobe pdf print settings I have bicubic downsampling to 2400-6000 pixels per inch).

My macro below automates the Acrobat PDFMaker add-in - in the Excel UI it is the Create PDF item in the Acrobat menu. You must set a reference to AdobePDFMakerForOffice, via Tools - References in the VBA editor, otherwise the code won't run.

The GetCurrentConversionSettings method, used by the macro, implies that it reads the current preferences/settings set by the user in the Acrobat PDFMaker dialogue, so it should pick up the image resolution settings you have set.

There doesn't seem to be any official documentation for the AdobePDFMakerForOffice classes. The only information I found was this:

How do I invoke Word PDFMaker from a macro?

Hi, I need to automate creating PDF's from Word with hyperlink fields converted precisely. The Adobe toolbar "Convert to Adobe PDF" button does exactly what I need. How do I invoke this type of conversion programmaticially, e.g. from a Word macro? Can anyone point me to a SDK document that...

community.adobe.com

and this Foxit document (page 33), where the ISettings class seems to be only a subset of the Adobe ISettings class:

https://cdn01.foxitsoftware.com/pub/foxit/manual/phantom/en_us/APIReferenceforApplicationCommunication_11.0.pdf

Public Sub Create_Acrobat_PDF()

    'References required: AdobePDFMakerForOffice

    Dim ca As COMAddIn
    Dim PDF As AdobePDFMakerForOffice.PDFMaker
    Dim PDFsettings As AdobePDFMakerForOffice.ISettings
    Dim PDFfile As String
    Dim conversionResult As Long
        
    'Find PDFMaker add-in
    
    Set PDF = Nothing
    For Each ca In Application.COMAddIns
        If InStr(UCase(ca.Description), "PDFMAKER") Then
            Set PDF = ca.Object
            Exit For
        End If
    Next
    
    If PDF Is Nothing Then
        MsgBox "Cannot find PDFMaker add-in", vbOKOnly + vbCritical, "Create Acrobat PDF"
        Exit Sub
    End If
    
    PDFfile = Replace(ThisWorkbook.FullName, ".xlsm", " PDF OUTPUT.pdf")
    If Dir(PDFfile) <> vbNullString Then Kill PDFfile
    
    PDF.GetCurrentConversionSettings PDFsettings
    With PDFsettings
        .AddBookmarks = True
        .AddLinks = True
        .AddTags = True
        .ConvertAllPages = True
        .CreateFootnoteLinks = True
        .CreateXrefLinks = True
        .OutputPDFFileName = PDFfile
        .PromptForPDFFilename = False
        .ShouldShowProgressDialog = True
        .ViewPDFFile = False
        .PrintActivesheetOnly = True        'Only convert the active sheet. The default value is true
        .PromptForSheetSelection = False    'Whether to pop up SheetSelection dialog. Ignored if PrintActivesheetOnly is False
        .IsConversionSilent = True
    End With
    
    PDF.CreatePDFEx PDFsettings, conversionResult
    
    If Dir(PDFfile) = vbNullString Then
        MsgBox "Could not create " & PDFfile, vbOKOnly + vbExclamation, "Create Acrobat PDF"
    End If
    
End Sub