VBA not working in PDF

[bmalak]

The code below creates a table of contents and allows the user to double click on any cell bringing up the desired page. However, this function does not work after the visio drawing is converted to PDF form. Hyperlinks, on the other hand, work inside the PDF. How can I get this to perform within a PDF? Thank you.

Sub TableOfContents()
Dim PageObj As Visio.Page
Dim TOCEntry As Visio.Shape
Dim CellOjb As Visio.Cell
Dim PosY As Double
Dim PageCnt As Double
Dim PageNr As Double

PageCnt = 0
For Each PageObj In ActiveDocument.Pages
If PageObj.Background = False Then PageCnt = PageCnt + 1
Next

For Each PageObj In ActiveDocument.Pages
If PageObj.Background = False Then
PageNr = PageNr + 1

PosY = (PageCnt + 1 - PageObj.Index) / 8 + 7.75

Set TOCEntry = ActiveDocument.Pages(2).DrawRectangle(1, PosY, 3.5, PosY + 0.125)
TOCEntry.Cells("Para.HorzAlign").Formula = visHorzLeft

TOCEntry.Text = PageNr & "." & " " & PageObj.Name & vbTab

Set CellObj = TOCEntry.CellsSRC(visSectionObject, visRowEvent, visEvtCellDblClick)

CellObj.Formula = "GOTOPAGE(""" + PageObj.Name + """)"
End If
Next
End Sub

[wapperdude]

Not sure, but Visio may prohibit this.  Code embedded in PDF is a serious security issue.

[Surrogate]

CellObj.Formula = "GOTOPAGE(""" + PageObj.Name + """)"

GOTOPAGE is ShapeSheet function and dont works in PDF, try add hyperlinks

[Surrogate]

Please try this code

Code Select Expand

Sub TableOfContents_HL()
Dim PageObj As Visio.Page
Dim TOCEntry As Visio.Shape
Dim CellOjb As Visio.Cell
Dim PosY As Double
Dim PageCnt As Double
Dim PageNr As Double
Dim vsoHlink1 As Visio.Hyperlink
PageCnt = 0
For Each PageObj In ActiveDocument.Pages
If PageObj.Background = False Then PageCnt = PageCnt + 1
Next
For Each PageObj In ActiveDocument.Pages
If PageObj.Background = False Then
PageNr = PageNr + 1
PosY = (PageCnt + 1 - PageObj.Index) / 8 + 7.75
Set TOCEntry = ActiveDocument.Pages(2).DrawRectangle(1, PosY, 3.5, PosY + 0.125)
TOCEntry.Cells("Para.HorzAlign").Formula = visHorzLeft
TOCEntry.Text = PageNr & "." & " " & PageObj.Name & vbTab
' add hyperlink which works in Visio
Set CellObj = TOCEntry.CellsSRC(visSectionObject, visRowEvent, visEvtCellDblClick)
ttt = "Hyperlink("""", """ & PageObj.NameU & """)"
CellObj.FormulaU = ttt
' add hyperlink which works in PDF
    Set vsoHlink1 = TOCEntry.Hyperlinks.Add
    vsoHlink1.Name = "Row_1"
    vsoHlink1.SubAddress = PageObj.Name
End If
Next
End Sub

[wapperdude]

@Surrogate:  My apology.  Seems I can't read my old code.  Of course you are correct.  Hyperlinks must be added.
@OP:  In addition to the GOTOPAGE() fcn that I also used for the double click event.  I also added creation of hyperlinks for PDF application.  Here's snippet of what I used in my code:

Code Select Expand


                    Set cellobj = .CellsSRC(visSectionObject, visRowEvent, visEvtCellDblClick)
                    cellobj.Formula = "GOTOPAGE(""" + pgObj.Name + """)"
'*****
'*****
                    Dim vsoHlink1 As Visio.Hyperlink

                    Set vsoHlink1 = .Hyperlinks.Add
                    vsoHlink1.Name = cellobj.ResultStr("")
                    vsoHlink1.SubAddress = pgObj


Note: I'm using the With syntax construct, so my 1st indicated line of code does not show the shapename variable. 

You can see similarities between both your and Surrogates code.  Sorry for the confusion for those who have previously looked at this.  It was so wrong that I completely re-wrote it.