Creating table of contents and exporting to PDF with VBA

Lane358

New Member
Joined
Jan 16, 2023
Messages
4
Office Version
  1. 365
Hello, I am just dabbling in VBA so please be patient with me and try to use minimal technical terms... Basically, I created this Frankenstein of a code below by combining different codes I found online and writing some myself. It is not pretty, I am sure it can be written cleaner, but it works.

Basically what it does is that it cycles through a data validation range I have in one cell that fills up the form I have on one of the sheets with info from different employees. It then copies this form onto a temporary sheet, adds pagebreak, goes to another employee and adds it to the bottom of the last copy. In the end it prints a pdf file that has filled out forms for each employee on different pages.

What I am trying to do now is create a sort of table of contents on first page with hyperlinks to each employee. I have trouble with hyperlinks not working after I export them into pdf... I have read dozens and dozens of threads and I can't seem to figure it out. I am at my wits end... Is it even possible? Please help if you can, thanks!

VBA Code:
Public Sub PrintCollated()

    Dim PDFfullName As String
    Dim PDFsheet As Worksheet
    Dim destCell As Range
    Dim wsName As Variant
    Dim dataValidationCell As Range, dataValidationListSource As Range, dvValueCell As Range
    Dim copyRange As Range
    Dim i As Integer
    
    PDFfullName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Worksheets("InputList").Range("B9").Value
   
    'Add temporary sheet for PDF output
    
    With ActiveWorkbook
        Set PDFsheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
    End With
    Set PDFsheet = ActiveSheet
    ActiveSheet.PageSetup.PaperSize = xlPaperA4
    With PDFsheet.Range("A:N")
        .ColumnWidth = 5.57
    End With
    
    
    With PDFsheet
        .HPageBreaks.Add Before:=.Rows(.UsedRange.Rows.Count + 1)
        Set destCell = .Cells(.UsedRange.Rows.Count + 1, 1)
        'i = ActiveSheet.UsedRange.Rows.Count + 28
    End With
    'Set destCell = PDFsheet.Range("A1")
    i = 28
    
    'Loop through specified sheets
    
    For Each wsName In Array("Report")
    
        'Cell containing data validation in-cell dropdown
    
        Set dataValidationCell = ActiveWorkbook.Worksheets(wsName).Range("I3")
         
        'Source of data validation list
        
        Set dataValidationListSource = Evaluate(dataValidationCell.Validation.Formula1)
         
        'Set each data validation value in this sheet to update sheet cells
        
        For Each dvValueCell In dataValidationListSource
        
            dataValidationCell.Value = dvValueCell.Value
            
            'Copy sheet cells to next cell in temporary PDF sheet
            
            Set copyRange = dataValidationCell.Worksheet.UsedRange
            dataValidationCell.Worksheet.Activate
            copyRange.Select
            Selection.Copy
            PDFsheet.Activate
            'destCell.Select
            'ActiveSheet.Paste
            destCell.PasteSpecial xlPasteValues
            destCell.PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
            Range("A" & i).EntireRow.RowHeight = 20
            Range("A" & i + 2).EntireRow.RowHeight = 9.25
            Range("A" & i + 3).EntireRow.RowHeight = 16.25
            Range("A" & i + 4).EntireRow.RowHeight = 9.25
            Range("A" & i + 5).EntireRow.RowHeight = 16.25
            Range("A" & i + 6).EntireRow.RowHeight = 9.25
            Range("A" & i + 7).EntireRow.RowHeight = 16.25
            Range("A" & i + 8).EntireRow.RowHeight = 9.25
            Range("A" & i + 9).EntireRow.RowHeight = 16.25
            Range("A" & i + 10).EntireRow.RowHeight = 9.25
            Range("A" & i + 11).EntireRow.RowHeight = 16.25
            Range("A" & i + 12).EntireRow.RowHeight = 9.25
            Range("A" & i + 13).EntireRow.RowHeight = 16.25
            Range("A" & i + 14).EntireRow.RowHeight = 12
            i = i + 58

            'Add page break and update destination cell
            
            With PDFsheet
                .HPageBreaks.Add Before:=.Rows(.UsedRange.Rows.Count + 1)
                Set destCell = .Cells(.UsedRange.Rows.Count + 1, 1)
            End With
        
        Next
        
    Next
    
    'Save temporary sheet as .pdf file
    
    PDFsheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfullName, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    
    'Delete temporary sheet
    
    'Application.DisplayAlerts = False
    'PDFsheet.Delete
    'Application.DisplayAlerts = True
    
    'clear hyperlinks in workbook
    'ThisWorkbook.Sheets("EmployeeList").Hyperlinks.Delete
    
End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
You cannot do this in VBA, and I don't know of any automated way to do it in exactly the way you have described it.

One thing I have done recently is to use the PDFtk server (free software) to build bookmarks, which act as a table of contents with links, but they are not actually a page in the document. But this is done outside of VBA. I use VBA to build the index, but then manually run PDFtk to use that index to insert the bookmarks. If that sounds like something you're interested in I can provide more detail.
 
Upvote 0
Solution
Hey, thanks for the reply. I do need it to be a page in the document itself. Plus I am still kinda hoping maybe someone knows a way to do it. I mean Excel and PDF has been out for ages and it seems such a common thing people would want to do. It seems crazy to me that the functionality is not there.
 
Upvote 0
You might be able to do it if you have Adobe Acrobat Professional. It has an API interface to VBA.
 
Upvote 0
You might be able to do it if you have Adobe Acrobat Professional. It has an API interface to VBA.
Yeah, I dug up some really old threads that suggested that. Unfortunately, since this is for work computer buying new software would involve an impassable wall of bureaucracy.

I did end up using PDFtk like you suggested. Works great, apart from somehow turning 2MB file into 6MB file just with addition of bookmarks. You mentioned you manually run PDFtk... Did you know you can use Command Prompt from VBA itself? I managed to completely automate the process just with VBA. Let me know if you want more info.
 
Upvote 0
You mentioned you manually run PDFtk... Did you know you can use Command Prompt from VBA itself?
Yes, I did know. I was moving forward one step at a time as a proof of concept. There wasn't much point in knocking myself out to automate something in VBA unless I knew first that PDFtk was going to do what I needed. Ultimately I will make it a one-click process.
 
Upvote 0

Forum statistics

Threads
1,215,403
Messages
6,124,710
Members
449,182
Latest member
mrlanc20

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