Adding PDF as background (watermark)

[Pastafarian]

Hello,

I have a sheet that gets saved as PDF (currently using the .ExportAsFixedFormat method), works flawlessly. I'd like to add a PDF-background to this PDF, like a watermark. Reason for this is that the header and footer settings in Excel just aren't advanced enough and can't offer real high quality pictures. I've searched the internet far and wide for an solution but couldn't find any for this, many questions regarding this were unanswered.

As far as I know this isn't possible in Excel itself and will require a 3rd party program. I've been looking into PDFCreator, and PDFCreator2.0 and 2.1 support adding PDF backgrounds to your PDF. You can setup the program to automatically add a PDF as a background to all your PDF's, however v2.0 and v2.1 do not support Excel VBA. Version 1.7.3 does support Excel VBA, but this version doesnt support adding watermarks.

The code I have so far for saving a sheet as PDF in PDF Creator 1.7.3 is as following, it works flawlessly but only saves your sheet to PDF and doesnt add a watermark:

#If VBA7 Then    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#Else
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If




Public Function PrintThisDoc(Formname As Long, FileName As String)
  On Error Resume Next
  Dim X As Long
  X = ShellExecute(Formname, "Print", FileName, 0&, 0&, 1)
End Function

Option ExplicitSub PrintToPDF_Early()
'Author       : Ken Puls (www.excelguru.ca)
'Macro Purpose: Print to PDF file using PDFCreator
'   (Download from http://sourceforge.net/projects/pdfcreator/)
'   Designed for early bind, set reference to PDFCreator


    Dim pdfjob As PDFCreator.clsPDFCreator
    Dim sPDFName As String
    Dim sPDFPath As String
    Dim bRestart As Boolean


    '/// Change the output file name here! ///
    sPDFName = "testPDF.pdf"
    sPDFPath = ActiveWorkbook.path & Application.PathSeparator


    'Check if worksheet is empty and exit if so
    If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub


    'Activate error handling and turn off screen updates
    On Error GoTo EarlyExit
    Application.ScreenUpdating = False
    Set pdfjob = New PDFCreator.clsPDFCreator


    'Check if PDFCreator is already running and attempt to kill the process if so
    Do
        bRestart = False
        Set pdfjob = New PDFCreator.clsPDFCreator
        If pdfjob.cStart("/NoProcessingAtStartup") = False Then
            'PDF Creator is already running.  Kill the existing process
            Shell "taskkill /f /im PDFCreator.exe", vbHide
            DoEvents
            Set pdfjob = Nothing
            bRestart = True
        End If
    Loop Until bRestart = False


    'Assign settings for PDF job
    With pdfjob
        .cOption("UseAutosave") = 1
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveDirectory") = sPDFPath
        .cOption("AutosaveFilename") = sPDFName
        .cOption("AutosaveFormat") = 0    ' 0 = PDF
        .cClearCache
    End With


    'Delete the PDF if it already exists
    If Dir(sPDFPath & sPDFName) = sPDFName Then Kill (sPDFPath & sPDFName)


    'Print the document to PDF
    ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"


    'Wait until the print job has entered the print queue
    Do Until pdfjob.cCountOfPrintjobs = 1
        DoEvents
    Loop
    pdfjob.cPrinterStop = False


    'Wait until the file shows up before closing PDF Creator
    Do
        DoEvents
    Loop Until Dir(sPDFPath & sPDFName) = sPDFName


Cleanup:
    'Release objects and terminate PDFCreator
    Set pdfjob = Nothing
    Shell "taskkill /f /im PDFCreator.exe", vbHide
    On Error GoTo 0
    Application.ScreenUpdating = True
    Exit Sub


EarlyExit:
    'Inform user of error, and go to cleanup section
    MsgBox "There was an error encountered.  PDFCreator has" & vbCrLf & _
           "has been terminated.  Please try again.", _
           vbCritical + vbOKOnly, "Error"
    Resume Cleanup
End Sub

Anyone know any way to alter this to put a PDF watermark/background behind it or any other way for putting PDF's as background?

Much appreciated!

 

[Kenneth Hobson]

This is an old thread but has no replies. Either a solution was found or you gave up.

If you have Adobe Acrobat, not Reader, I could show you how to do it.

Seems like PDFCreator v2.1 could do it. Who told you that v2.1 would not work in VBA? Maybe that is buried in the help file. The few JScript code examples with it does not work for me.

This is kludgy but sort of works for merging. Adobe Reader stays open but eventually does close. It should give you an idea to get started. I posted part of it at the commented link.

'http://www.excelguru.ca/forums/showthread.php?4733-merging-multiple-PDF-files-into-a-single-PDF-file-via-VBA-macro
Sub Test_PDFCreatorCombine()
  Dim fn(0 To 1) As String, s As String
  fn(0) = "x:\pdf\ken.pdf"
  fn(1) = "x:\pdf\ken2.pdf"
  s = "x:\pdf\PDFCreatorCombined.pdf"
  PDFCreatorCombine fn(), s
      
  If vbYes = MsgBox(s, vbYesNo + vbQuestion, "Open?") Then Shell ("cmd /c " & """" & s & """")
End Sub

'Macro Purpose: Print to PDF file using PDFCreator
' (Download from http://sourceforge.net/projects/pdfcreator/)
' COM interface, http://www.pdfforge.org/pdfcreator/manual/com-interface
' Designed for early bind, set reference to: PDFCreator - Your OpenSource PDF Solution
Sub PDFCreatorCombine(sPDFName() As String, sMergedPDFname As String)
  Dim oPDF As PDFCreator.PdfCreatorObj, q As PDFCreator.Queue
  Dim pj As PrintJob
  Dim v As Variant, i As Integer
  Dim fso As Object
  
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  Set q = New PDFCreator.Queue
  With q
    .Initialize
    If LBound(sPDFName) = 0 Then
      .WaitForJobs UBound(sPDFName) + 1, 1
      Else
      .WaitForJobs UBound(sPDFName), 1
    End If
  
    
    Set oPDF = New PDFCreator.PdfCreatorObj  'PDFCreator.clsPDFCreator
  
    i = 0
    For Each v In sPDFName()
      If fso.FileExists(v) Then oPDF.PrintFile v
      i = i + 1
    Next v
    .MergeAllJobs
    
    Set pj = q.NextJob
    With pj
      .SetProfileByGuid "DefaultGuid"
      .SetProfileSetting "Printing.PrinterName", "PDFCreator"
      .SetProfileSetting "Printing.SelectPrinter", "SelectedPrinter"
      .SetProfileSetting "OpenViewer", "false"
      .SetProfileSetting "OpenWithPdfArchitect", "false"
      .SetProfileSetting "ShowProgress", "false"
      .ConvertTo sMergedPDFname
    End With
  
    .ReleaseCom
  End With
End Sub

 

[Pastafarian]

Thanks for your reaction. Unfortunately your solution doesnt work for me for some reason. It just opens Adobe Reader which I then have to close by hand, it opens it again, have to close it again, then it saves the 'combined' PDFfile, but it never combined the two PDF's, it only used the first PDF to make the combined one. I've tried adjusting the code, but can't seem to get it to work.

I have Adobe Acrobat, is there a easier way to accomplish the goal with Acrobat?

Thanks for the help so far!

 

[Kenneth Hobson]

Add Background to PDF using Excel VBA
Create PDFs Using Excel VBA?

Sub Test_WatermarkPDF() 
    Dim base_PDF As String, watermark_PDF As String 
    Dim cell As Range, i As Integer 
    base_PDF = ThisWorkbook.Path & "\Base_PDF.pdf" 
    watermark_PDF = ThisWorkbook.Path & "\Watermark_PDF.pdf" 
     
     ' Make a basePDF
    Sheet1.Cells.Clear 
    i = 0 
    For Each cell In Sheet1.Range("A1:F100") 
        i = i + 1 
        cell.Value2 = i 
    Next cell 
    ActiveSheet.PageSetup.PrintArea = "$A$1:$F$100" 
    PublishToPDF base_PDF, Sheet1 
     
     ' Make a watermakePDF
    Sheet2.Cells.Clear 
    Sheet2.Range("A1").Value2 = "DRAFT" 
    With Sheet2.Range("A1").Font 
        .Name = "Algerian" 
        .Size = 72 
        .Strikethrough = False 
        .Superscript = False 
        .Subscript = False 
        .OutlineFont = False 
        .Shadow = False 
        .Underline = xlUnderlineStyleNone 
        .Color = -16776961 
        .TintAndShade = 0 
        .ThemeFont = xlThemeFontNone 
    End With 
    With Sheet2.Range("A1") 
        .HorizontalAlignment = xlCenter 
        .VerticalAlignment = xlCenter 
        .WrapText = False 
        .Orientation = 45 
        .AddIndent = False 
        .IndentLevel = 0 
        .ShrinkToFit = False 
        .ReadingOrder = xlContext 
        .MergeCells = False 
    End With 
    PublishToPDF watermark_PDF, Sheet2 
     
    watermarkPDF base_PDF, watermark_PDF 
End Sub 
 
 ' Add Tools > References... > Adobe
 ' JavaScript API: [URL="http://www.adobe.com/content/dam/Adobe/en/devnet/acrobat/pdfs/js_api_reference.pdf"]http://www.adobe.com/content/dam/Adobe/en/devnet/acrobat/pdfs/js_api_reference.pdf[/URL]
Function watermarkPDF(base_PDF As String, WatermarkPDF_AX As String) 
    Dim bolResult As Boolean 
    Dim pdfDoc1 As AcroPDDoc 
    Dim jsObj As Object 
     
    Set pdfDoc1 = CreateObject("AcroExch.PDDoc") 
     
    If pdfDoc1.Open(base_PDF) Then 
        Set jsObj = pdfDoc1.GetJSObject 
         'jsObj.addWatermarkFromFile WatermarkPDF_AX ', bOnTop:=False
         'jsObj.addWatermarkFromFile WatermarkPDF_AX, 0, 0, 0, False, True, True, 0, 0, 0, 0, False, 1, False, 0, 1
         ' Pg. 272
        jsObj.addWatermarkFromFile WatermarkPDF_AX, 0, 0, 100, False, True, True, 0, 0, 0, 0, False, 1, True, 0, 1 
    End If 
     
    pdfDoc1.Save 1, base_PDF 
     
    pdfDoc1.Close 
     
    Set jsObj = Nothing 
    Set pdfDoc1 = Nothing 
     
End Function 
 
Sub PublishToPDF(fName As String, ws As Worksheet) 
    Dim rc As Variant 
     
     'ChDrive "c:"
     'ChDir GetFolderName(fName)
    rc = Application.GetSaveAsFilename(fName, "PDF (*.pdf), *.pdf", 1, "Publish to PDF") 
    If rc = "" Then Exit Sub 
     
    ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fName _ 
    , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ 
    :=False, OpenAfterPublish:=False 
End Sub

 

[Pastafarian]

Weird, I've tried that piece of code before, but kept getting errors.
I've adjusted it to match my needs and now it works flawlessly!

People who need something similar can use the code Kenneth posted.
Keep in mind you need to enable the Adobe Acrobat references.

Thanks a ton Kenneth!