VBA to place images inside a PDF???

S

sebby_joe

New Member
Joined
Nov 24, 2020
Messages
12
Office Version
  1. 365
Platform
  1. Windows
Hey guys,
Is it possible to use VBA to place images inside an existing PDF with accuracy and precision? Even better, could VBA be used to place said images into an INDD file? If not, is there a different scripting language that is suited for such a task?

I’ve been creating print-advertising postcards for a realtor client, and the process is monotonous, so I’m desperate to automate my current workflow as much as possible.

I’d appreciate a push in the right direction or any thoughts all y’all may have.

Thank you!
 
Sort by date Sort by votes
Hello @John_w !
Tahnk you for this post - I've saved a lot of time!

What If I want to do this in the Loop? or with the "Fot" statement?
 
Upvote 0

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Sabat01 said:
What If I want to do this in the Loop? or with the "Fot" statement?
Click to expand...

Change the main procedure into a subroutine with arguments for the input and output PDF and the image file (full file names including path):

VBA Code: 
Public Sub Insert_Image_In_PDF_Pages(PDFinputFile As String, PDFoutputFile As String, imageFile As String)

    Dim AcrobatApp As Acrobat.AcroApp
    Dim AcroAVDocInput As Acrobat.AcroAVDoc
    Dim AcroPDDocInput As Acrobat.AcroPDDoc
    Dim jso As Object
    Dim pageRect As Variant
    Dim pageField As Object
    Dim fieldRect(0 To 3) As Double
    Dim page As Long
        
    Set AcrobatApp = New Acrobat.AcroApp        'CreateObject("AcroExch.App")
    Set AcroAVDocInput = New Acrobat.AcroAVDoc  'CreateObject("AcroExch.AVDoc")
    
    If AcroAVDocInput.Open(PDFinputFile, "") Then
    
        Set AcroPDDocInput = AcroAVDocInput.GetPDDoc()
    
        Set jso = AcroPDDocInput.GetJSObject
        
        For page = 0 To AcroPDDocInput.GetNumPages() - 1
        
            'Get page boundary coordinates - could be used to calculate position of button
            pageRect = jso.getPageBox("Crop", page)
            
            'Coordinates of button to be added - top-left (x,y), bottom-right (x,y)
            fieldRect(0) = 0
            fieldRect(1) = 135
            fieldRect(2) = 240
            fieldRect(3) = 0
            
            'Add button with image to this page
            Set pageField = jso.addField("button" & page + 1, "button", page, fieldRect)
            On Error Resume Next 'ignore "Run-time error '1001'" because the image is successfully added
            pageField.buttonImportIcon imageFile
            On Error GoTo 0
            pageField.buttonPosition = jso.Position.iconOnly
            pageField.ReadOnly = True
            
        Next
        
        'Save as output PDF
        
        AcroPDDocInput.Save 1, PDFoutputFile
        AcroAVDocInput.Close True
        
        'Open the output PDF
        
'        If AcroAVDocInput.Open(PDFoutputFile, "") Then
'            AcrobatApp.Show
'            AppActivate Mid(PDFoutputFile, InStrRev(PDFoutputFile, "\") + 1), False
'        End If

    Else
    
        MsgBox "Unable to open PDF input file" & vbCrLf & PDFinputFile
        
    End If

    Set AcroPDDocInput = Nothing
    Set AcroAVDocInput = Nothing
    Set AcrobatApp = Nothing

End Sub

Then call the above subroutine in a loop with the appropriate arguments. For example you could loop through sheet rows and read the file names from cells or loop through a folder looking for *.pdf files, like this:
VBA Code: 
Public Sub Loop_Insert_Image_In_PDFs()

    Dim PDFfolder As String
    Dim PDFfile As String
    Dim imageFile As String
    
    imageFile = "C:\path\to\image.jpg"
    PDFfolder = "C:\path\to\PDFs\"
    
    PDFfile = Dir(PDFfolder & "*.pdf")
    While PDFfile <> vbNullString
        Insert_Image_In_PDF_Pages PDFfolder & PDFfile, PDFfolder & Replace(PDFfile, ".pdf", " WITH IMAGE ON EACH PAGE.pdf", Compare:=vbTextCompare), imageFile
        PDFfile = Dir
    Wend
    
End Sub
 
Upvote 0
Thank you @John_w
It helped !

I have a bit different way, but it helped!

Is there any option to recognize PDF format and orientation?

Is there a way to contact with you ?
 
Upvote 0
Sabat01 said:
Is there any option to recognize PDF format and orientation?
Click to expand...

With this part of my code:
VBA Code: 
            'Get page boundary coordinates - could be used to calculate position of button
            pageRect = jso.getPageBox("Crop", page)
interpret the values in the pageRect array to determine whether the page is landscape or portrait. Or there might be another way.

What do you mean by PDF format?

Sabat01 said:
Is there a way to contact with you ?
Click to expand...
No, please stick to posting on this forum and I'll answer when possible.
 
Upvote 0
Ok then,

I will continue here,

PDF format by meaning of size: A3, A4, etc.
Over the loop sometimes there could be A4 landscape oriented and sometimes A3 portrait and the other combination. This variants make images located in random places.

The second thing is,
How to add image to all pdfs in the specified folder instead of one pdf ?
In the next post I will share entire code:
Believe this helps others!
 
Upvote 0
Sabat01 said:
The second thing is,
How to add image to all pdfs in the specified folder instead of one pdf ?
Click to expand...

I've already posted the code for that - see post #12.

Sabat01 said:
PDF format by meaning of size: A3, A4, etc.
Over the loop sometimes there could be A4 landscape oriented and sometimes A3 portrait and the other combination. This variants make images located in random places.
Click to expand...

With this line:
VBA Code: 
pageRect = jso.getPageBox("Crop", page)

getPageBox returns a rectangle that encompasses the "Crop" box for the specified page number (0 is the first page): pageRect is a 4-element array containing 2 pairs of coordinates for the top-left (x,y) and bottom-right (x,y) corners of the rectangle of the "Crop" box. The 4 values will vary depending on the page size (A3, A4, etc.) and its orientation (portrait or landscape). You can use those values to calculate the required size and position of the image field in the fieldRect array. This is also a 4-element array containing 2 pairs of coordinates for the top-left (x,y) and bottom-right (x,y) corners of the image to be added.

I have modified the Insert_Image_In_PDF_Pages subroutine to first get the width and height of the specified image file and then position the image at the bottom-left of the "Crop" box. I've also shown the calculations for placing the image in 8 other positions: bottom-right, top-left, top-right, bottom-middle, top-middle, middle-left, middle-right and middle-middle.

The first parameter of getPageBox is a string specifying the type of box you want to use and there are 5 possible values:

Art​
Bleed​
BBox​
Crop (default)​
Trim​

See https://acrobatusers.com/tutorials/print/finding-page-boundaries/ for the definitions of these boxes.

BBox is the bounds of the actual content on the page, so the following line could be used instead to position the image relative to the actual page contents:

VBA Code: 
pageRect = jso.getPageBox("BBox", page)

Note that the calculations for the 9 different positions of the image remain exactly the same, because they are all relative to the size and position of the specified box.

VBA Code: 
Public Sub Insert_Image_In_PDF_Pages(PDFinputFile As String, PDFoutputFile As String, imageFile As String)

    Dim AcrobatApp As Acrobat.AcroApp
    Dim AcroAVDocInput As Acrobat.AcroAVDoc
    Dim AcroPDDocInput As Acrobat.AcroPDDoc
    Dim jso As Object
    Dim pageRect As Variant
    Dim pageField As Object
    Dim fieldRect(0 To 3) As Double
    Dim page As Long
    Dim imageWidth As Long, imageHeight As Long
   
    GetImageDimensions imageFile, imageWidth, imageHeight
       
    Set AcrobatApp = New Acrobat.AcroApp        'CreateObject("AcroExch.App")
    Set AcroAVDocInput = New Acrobat.AcroAVDoc  'CreateObject("AcroExch.AVDoc")
   
    If AcroAVDocInput.Open(PDFinputFile, "") Then
   
        Set AcroPDDocInput = AcroAVDocInput.GetPDDoc()
   
        Set jso = AcroPDDocInput.GetJSObject
       
        For page = 0 To AcroPDDocInput.GetNumPages() - 1
       
            'Get rectangle that encompasses the "Crop" box for the page: a 4-element array containing 2 pairs of coordinates for the top-left (x,y) and bottom-right (x,y) corners of the box
            pageRect = jso.getPageBox("Crop", page)
           
            'Or - Get rectangle that encompasses the "BBox" (bounding box) for the page
            'pageRect = jso.getPageBox("BBox", page)
           
            'Define coordinates of top-left (x,y) and bottom-right (x,y) corners of button to be added, relative to the specified box
           
            'Bottom-left
            fieldRect(0) = pageRect(0)
            fieldRect(1) = pageRect(3) + imageHeight
            fieldRect(2) = pageRect(0) + imageWidth
            fieldRect(3) = pageRect(3)
               
'            'Bottom-right
'            fieldRect(0) = pageRect(2) - imageWidth
'            fieldRect(1) = pageRect(3) + imageHeight
'            fieldRect(2) = pageRect(2)
'            fieldRect(3) = pageRect(3)
'
'            'Top-left
'            fieldRect(0) = pageRect(0)
'            fieldRect(1) = pageRect(1)
'            fieldRect(2) = pageRect(0) + imageWidth
'            fieldRect(3) = pageRect(1) - imageHeight
'
'            'Top-right
'            fieldRect(0) = pageRect(2) - imageWidth
'            fieldRect(1) = pageRect(1)
'            fieldRect(2) = pageRect(2)
'            fieldRect(3) = pageRect(1) - imageHeight
'
'            'Bottom-middle
'            fieldRect(0) = pageRect(0) + (pageRect(2) - pageRect(0) - imageWidth) / 2
'            fieldRect(1) = pageRect(3) + imageHeight
'            fieldRect(2) = pageRect(0) + (pageRect(2) - pageRect(0) + imageWidth) / 2
'            fieldRect(3) = pageRect(3)
'
'            'Top-middle
'            fieldRect(0) = pageRect(0) + (pageRect(2) - pageRect(0) - imageWidth) / 2
'            fieldRect(1) = pageRect(1)
'            fieldRect(2) = pageRect(0) + (pageRect(2) - pageRect(0) + imageWidth) / 2
'            fieldRect(3) = pageRect(1) - imageHeight
'
'            'Middle-left
'            fieldRect(0) = pageRect(0)
'            fieldRect(1) = pageRect(3) + (pageRect(1) - pageRect(3) - imageHeight) / 2
'            fieldRect(2) = pageRect(0) + imageWidth
'            fieldRect(3) = pageRect(3) + (pageRect(1) - pageRect(3) + imageHeight) / 2
'
'            'Middle-right
'            fieldRect(0) = pageRect(2) - imageWidth
'            fieldRect(1) = pageRect(3) + (pageRect(1) - pageRect(3) - imageHeight) / 2
'            fieldRect(2) = pageRect(2)
'            fieldRect(3) = pageRect(3) + (pageRect(1) - pageRect(3) + imageHeight) / 2
'
'            'Middle-middle
'            fieldRect(0) = pageRect(0) + (pageRect(2) - pageRect(0) - imageWidth) / 2
'            fieldRect(1) = pageRect(3) + (pageRect(1) - pageRect(3) - imageHeight) / 2
'            fieldRect(2) = pageRect(0) + (pageRect(2) - pageRect(0) + imageWidth) / 2
'            fieldRect(3) = pageRect(3) + (pageRect(1) - pageRect(3) + imageHeight) / 2
                                   
            'Add button with image to this page
            Set pageField = jso.addField("button" & page + 1, "button", page, fieldRect)
            On Error Resume Next 'ignore "Run-time error '1001'" because the image is successfully added
            pageField.buttonImportIcon imageFile
            On Error GoTo 0
            pageField.buttonPosition = jso.Position.iconOnly
            pageField.ReadOnly = True
           
        Next
       
        'Save as output PDF
       
        AcroPDDocInput.Save 1, PDFoutputFile
        AcroAVDocInput.Close True
       
        'Open the output PDF
       
'        If AcroAVDocInput.Open(PDFoutputFile, "") Then
'            AcrobatApp.Show
'            AppActivate Mid(PDFoutputFile, InStrRev(PDFoutputFile, "\") + 1), False
'        End If

    Else
   
        MsgBox "Unable to open PDF input file" & vbCrLf & PDFinputFile
       
    End If

    Set AcroPDDocInput = Nothing
    Set AcroAVDocInput = Nothing
    Set AcrobatApp = Nothing

End Sub

Private Sub GetImageDimensions(imageFile As String, widthPixels As Long, heightPixels As Long)
    Dim oWIA As Object
    Set oWIA = CreateObject("WIA.ImageFile")
    oWIA.LoadFile imageFile
    widthPixels = oWIA.Width
    heightPixels = oWIA.Height
End Sub
 
Upvote 0
Dear @John_w ,

Thank you for your help but I am stock now.

Everything was working until I started to try "stamp" all pdfs from the folder instead of one by one.

Could you please help?

This works for one by one:

VBA Code: 
Public Sub Insert_Images_In_PDF()

    Dim PDFinputFile As String
    Dim PDFoutputFile As String
    Dim imageFile As String
    Dim i As Integer
    
    Dim AcrobatApp As Acrobat.AcroApp
    Dim AcroAVDocInput As Acrobat.AcroAVDoc
    Dim AcroPDDocInput As Acrobat.AcroPDDoc
    
    Dim jso As Object
    Dim pageRect As Variant
    Dim pageField As Object
    Dim fieldRect(0 To 3) As Double
    Dim page As Long
    
    Set targetWorkbook = ThisWorkbook
    Set rh = targetWorkbook.Sheets("RCT")
    Set sh = targetWorkbook.Sheets("Stamper")
              
    lastrowA = rh.Cells(sh.Rows.Count, "A").End(xlUp).Row
    lastrowI = rh.Cells(sh.Rows.Count, "I").End(xlUp).Row
  
    For i = lastrowA - (lastrowA - lastrowI - 1) To rh.Range("A" & Application.Rows.Count).End(xlUp).Row
  
            PDFinputFile = "S:\01 PV\02 Proffesion\02 Engineering & QC\Rev_1 - Acrobat PRO - Multi\01 Drawings - Projects\" & rh.Range("F" & i).Value & ".pdf"
            imageFile = "S:\01 PV\02 Proffesion\02 Engineering & QC\Rev_1 - Acrobat PRO - Multi\02 Signatures\" & rh.Range("F" & i).Value & " " & "x" & " " & rh.Range("D" & i).Value & ".png"  'width 240 pixels, height 135 pixels
            PDFoutputFile = "S:\01 PV\02 Proffesion\02 Engineering & QC\Rev_1 - Acrobat PRO - Multi\03 Signed Drawings\" & rh.Range("F" & i).Value & " " & "x" & " " & rh.Range("D" & i).Value & ".pdf"
  
            Set AcrobatApp = New Acrobat.AcroApp        'CreateObject("AcroExch.App")
            Set AcroAVDocInput = New Acrobat.AcroAVDoc  'CreateObject("AcroExch.AVDoc")
  
  
            If AcroAVDocInput.Open(PDFinputFile, "") Then
            
            
                Set AcroPDDocInput = AcroAVDocInput.GetPDDoc()
                Set jso = AcroPDDocInput.GetJSObject
      
                For page = 0 To AcroPDDocInput.GetNumPages() - 1
            
            
                'Get page boundary coordinates - could be used to calculate position of button
                pageRect = jso.getPageBox("Crop", page)
          
                'Coordinates of button to be added - top-left (x,y), bottom-right (x,y)
                fieldRect(0) = 30
                fieldRect(1) = 120
            
                fieldRect(2) = 150
                fieldRect(3) = 10
          
                'Add button with image to this page
                Set pageField = jso.addField("button" & page + 1, "button", page, fieldRect)
            
                On Error Resume Next 'ignore "Run-time error '1001'" because the image is successfully added
            
                pageField.buttonImportIcon imageFile
                On Error GoTo 0
            
                pageField.buttonPosition = jso.Position.iconOnly
                pageField.ReadOnly = True
          
                Next
      
                'Save as output PDF
      
                AcroPDDocInput.Save 1, PDFoutputFile
                AcroAVDocInput.Close True
      
                'If AcroAVDocInput.Open(PDFoutputFile, "") Then
                'AcrobatApp.Show
                'AppActivate Mid(PDFoutputFile, InStrRev(PDFoutputFile, "\") + 1), True
                'End If

                Else
                MsgBox "Unable to open PDF input file" & vbCrLf & PDFinputFile
      
                End If

                
                rh.Range("I" & i).Value = 1

    Next i

                Set AcroPDDocInput = Nothing
                Set AcroAVDocInput = Nothing
                Set AcrobatApp = Nothing

End Sub




'Once I try to change for all pdfs from the folder:




Public Sub Insert_Images_In_PDF2()

    Dim PDFFolder As String
    Dim PDFiFile As String
    Dim PDFoFile As String
    Dim ImageFile As String
    Dim i As Integer
    
    Dim AcrobatApp As Acrobat.AcroApp
    Dim AcroAVDocInput As Acrobat.AcroAVDoc
    Dim AcroPDDocInput As Acrobat.AcroPDDoc
    
    Dim jso As Object
    Dim pageRect As Variant
    Dim pageField As Object
    Dim fieldRect(0 To 3) As Double
    Dim page As Long
    
    Set targetWorkbook = ThisWorkbook
    Set rh = targetWorkbook.Sheets("RCT")
    Set sh = targetWorkbook.Sheets("Stamper")
              
    lastrowA = rh.Cells(sh.Rows.Count, "A").End(xlUp).Row
    lastrowI = rh.Cells(sh.Rows.Count, "I").End(xlUp).Row
     
    For i = lastrowA - (lastrowA - lastrowI - 1) To rh.Range("A" & Application.Rows.Count).End(xlUp).Row
   
   
            ' There are 3-7 PDFs in the location
            PDFFolder = "S:\01 PV\02 Proffesion\02 Engineering & QC\Rev_2 - Acrobat PRO - Multi\01 Drawings\" & rh.Range("F" & i).Value & "\"
            PDFiFile = Dir(PDFFolder & "*.pdf")
            ' In the location, there are many images, but according to below - there is need to select just one for all pdfs in specified location
            ImageFile = "S:\01 PV\02 Proffesion\02 Engineering & QC\Rev_2 - Acrobat PRO - Multi\02 Signatures\" & rh.Range("D" & i).Value & ".png"
            'Would be nice to get orginal name of each pdf + image name and save them in the specified location
            PDFoFile = "S:\01 PV\02 Proffesion\02 Engineering & QC\Rev_2 - Acrobat PRO - Multi\03 Signed Drawings\" & rh.Range("D" & i).Value & "\" ' & "?????"
   
   
            Set AcrobatApp = New Acrobat.AcroApp        'CreateObject("AcroExch.App")
            Set AcroAVDocInput = New Acrobat.AcroAVDoc  'CreateObject("AcroExch.AVDoc")
   
   
                If AcroAVDocInput.Open(PDFiFile, "") Then

                Set AcroPDDocInput = AcroAVDocInput.GetPDDoc()
                Set jso = AcroPDDocInput.GetJSObject
       
                For page = 0 To AcroPDDocInput.GetNumPages() - 1
            
            
                'Get page boundary coordinates - could be used to calculate position of button
                pageRect = jso.getPageBox("Crop", page)
           
                'Coordinates of button to be added - top-left (x,y), bottom-right (x,y)
                fieldRect(0) = 20    
                fieldRect(1) = 120    
            
                fieldRect(2) = 100
                fieldRect(3) = 10    
           
                'Add button with image to this page
                Set pageField = jso.addField("button" & page + 1, "button", page, fieldRect)
            
                On Error Resume Next 'ignore "Run-time error '1001'" because the image is successfully added
            
                pageField.buttonImportIcon ImageFile
                On Error GoTo 0
            
                pageField.buttonPosition = jso.Position.iconOnly
                pageField.ReadOnly = True
           
                Next
       
                'Save as output PDF
       
                AcroPDDocInput.Save 1, PDFoFile
                AcroAVDocInput.Close True

                Else
                MsgBox "Unable to open PDF input file" & vbCrLf & PDFiFile
       
                End If

                
                rh.Range("I" & i).Value = 1

        Next i

                Set AcroPDDocInput = Nothing
                Set AcroAVDocInput = Nothing
                Set AcrobatApp = Nothing

End Sub
 
Upvote 0
Sabat01 said:
Everything was working until I started to try "stamp" all pdfs from the folder instead of one by one.
Click to expand...

It looks like you're reading the PDFs from sheet cells and rows, not from a folder. But why aren't you using the looping structure I showed in post #12, but looping through sheet rows instead of a folder? All your code is in one routine; my code is in two routines.
 
Upvote 0
Hi @John_w,

Due to many reasons, I would like to govern it that way. Based on the ongoing records, I would like to add images to the specified pdfs.

Is there possibility to take all pdfs from specified folder instead of one pdf that way?
 
Upvote 0
I don't see how your looping structure is necessary. Within the loop, you are still adding one image to all pages in one PDF. Easier to follow my post #12, but looping through rows and *.pdf in each folder.

Your looping code should be something like this (uncompiled, untested):

VBA Code: 
    Set targetWorkbook = ThisWorkbook
    Set rh = targetWorkbook.Sheets("RCT")
    Set sh = targetWorkbook.Sheets("Stamper")
             
    lastrowA = rh.Cells(sh.Rows.Count, "A").End(xlUp).Row
    lastrowI = rh.Cells(sh.Rows.Count, "I").End(xlUp).Row
    
    For i = lastrowA - (lastrowA - lastrowI - 1) To rh.Range("A" & Application.Rows.Count).End(xlUp).Row
  
            ' There are 3-7 PDFs in the location
            PDFFolder = "S:\01 PV\02 Proffesion\02 Engineering & QC\Rev_2 - Acrobat PRO - Multi\01 Drawings\" & rh.Range("F" & i).Value & "\"

            ' In the location, there are many images, but according to below - there is need to select just one for all pdfs in specified location
            ImageFile = "S:\01 PV\02 Proffesion\02 Engineering & QC\Rev_2 - Acrobat PRO - Multi\02 Signatures\" & rh.Range("D" & i).Value & ".png"
           
            Dim PDFfile As String
            PDFfile = Dir(PDFFolder & "*.pdf")
            While PDFfile <> vbNullString

                PDFiFile = PDFFolder & PDFfile
                PDFoFile = "S:\01 PV\02 Proffesion\02 Engineering & QC\Rev_2 - Acrobat PRO - Multi\03 Signed Drawings\" & rh.Range("D" & i).Value & "\" & PDFfile

                Insert_Image_In_PDF_Pages PDFiFile, PDFoFile, imageFile
               
               PDFfile = Dir
              
           Wend

           rh.Range("I" & i).Value = 1  
 
   Next
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
VBA to place images inside a PDF next to specific text???
Replies
1
Views
1K
John_w
J
G
  • Solved
Print as pdf button / VBA, but i need more compression (and automation)
Replies
9
Views
4K
John_w
J

Forum statistics

Threads
1,223,886
Messages
6,175,196
Members
452,616
Latest member
intern444

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top