Diesen Code habe ich auch versucht.. Ebenfalls ohne Erfolg
Sub Test_WatermarkPDF2()
Dim base_PDF As String, watermark_PDF As String, merged_PDF As String
Dim cell As Range, i As Integer
base_PDF = ThisWorkbook.Path & "\Base.pdf"
watermark_PDF = ThisWorkbook.Path & "\Backg.pdf"
merged_PDF = ThisWorkbook.Path & "\Merged_PDF.pdf"
If Dir(merged_PDF) <> "" Then
Kill merged_PDF
End If
FileCopy base_PDF, merged_PDF
watermarkPDF2 merged_PDF, watermark_PDF
End Sub
' [URL="http://www.vbaexpress.com/forum/showthread.php?t=39616"]http://www.vbaexpress.com/forum/showthread.php?t=39616[/URL]
' 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 watermarkPDF2(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
'For just the first page:
'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, False, 0, 1
End If
pdfDoc1.Save 1, base_PDF
pdfDoc1.Close
Set jsObj = Nothing
Set pdfDoc1 = Nothing
End Function
|