One day I got an electronic book about Oncology Statistics Rule in PDF format. The book is very good for beginners who is going to participate in oncology studies. Yet I was unable to search for words. No words in the document could be found even though they do exist. What was worse, there were no bookmarks. I had to scroll through the document page by page if I would like to search for some information. To provide convenience for navigation in future, I decided to add bookmark myself by using VBA.
Determine bookmarks level, bookmark title, and corresponding destination page number
Scrolling through the whole book page by page, bookmark titles, corresponding destination page numbers and bookmark levels were typed into Excel manually and organized as below. The first bookmark is “LIST OF TABLES” and it is expected to take us to page 4. Since it is in the first level and “Y” was entered into the second cell of column D. “2.1.1.1 Maximum Tolerated Dose (MTD)” is in the fourth level and Y was placed in column G.
VBA code to add multiple levels of bookmark into PDF
Suppose that name of worksheet is “Add Bookmark”. Following are the macro code that should be assigned to button “Add Bookmark”. Once you click on the button, bookmarks listed in column B will be added into PDF file in cell (2,1).
Click here to hide/show code
Sub AddBookmark()
Dim AcroApp As Acrobat.CAcroApp
Dim PDoc As Acrobat.CAcroPDDoc
Set AcroApp = CreateObject(“AcroExch.App”)
Set PDoc = CreateObject(“AcroExch.PDDoc”)
PDoc.Open (ThisWorkbook.Worksheets(“Add Bookmark”).Cells(2, 1))
Set jso = PDoc.GetJSObject
jso.BookmarkRoot.Remove
Set BMR = jso.BookmarkRoot
a = 0
For i = 2 To ThisWorkbook.Sheets(“Add Bookmark”).Range(“B” & Rows.Count).End(xlUp).Row
pg = ThisWorkbook.Sheets(“Add Bookmark”).Cells(i, 3) – 1
bm = ThisWorkbook.Sheets(“Add Bookmark”).Cells(i, 2)
af = ThisWorkbook.Sheets(“Add Bookmark”).Cells(i, 4)
bf = ThisWorkbook.Sheets(“Add Bookmark”).Cells(i, 5)
cf = ThisWorkbook.Sheets(“Add Bookmark”).Cells(i, 6)
df = ThisWorkbook.Sheets(“Add Bookmark”).Cells(i, 7)
If pg > “” And bm > “” And (af > “” Or bf > “” Or cf > “” Or df > “”) Then
If af = “Y” Then
BMR.createChild bm, “this.pageNum=” & pg, a
BMA = BMR.Children
Set oBMA = BMA(a)
a = a + 1
b = 0
c = 0
d = 0
End If
If bf = “Y” Then
oBMA.createChild bm, “this.pageNum=” & pg, b
BMB = oBMA.Children
Set oBMB = BMB(b)
b = b + 1
c = 0
d = 0
End If
If cf = “Y” Then
oBMB.createChild bm, “this.pageNum=” & pg, c
BMC = oBMB.Children
Set oBMC = BMC(c)
c = c + 1
d = 0
End If
If df = “Y” Then
oBMC.createChild bm, “this.pageNum=” & pg, d
d = d + 1
End If
Else
MsgBox “Row: ” & i & “, title or page number or bookmark level missing!”
Exit Sub
End If
Next i
n = PDoc.Save(PDSaveFull, ThisWorkbook.Worksheets(“Add Bookmark”).Cells(2, 1))
PDoc.Close
AcroApp.Exit
Set AcroApp = Nothing
Set PDoc = Nothing
Set ADoc = Nothing
MsgBox “Done!”
End Sub
Note
Limitation of this method is that Acrobat professional software must be installed and Reference like “Adobe Acrobat 9.0 Type Library” must be selected. ALT + F11 can enable you to open the VBA editor. References – VBAProject prompt box can be opened by clicking on Tools -> References.
