Table of Contents: Create a Table of Contents with hyper links for a Visio drawing.
from Zack Moore Microsoft
Код:
Sub CreateTableOfContents()
' creates a shape for each page in the drawing on the first page of the
' drawing then adds a hyperlink to each shape so you can click and go
' to that page
' define a toc shape
Dim TOCEntry As Visio.Shape
Dim PageToIndex As Visio.Page
Dim X As Integer
Dim hlink As Visio.Hyperlink
' loop through all the pages you have
For Each PageToIndex In Application.ActiveDocument.Pages
' you may want to refine this and use a top down algorithm with
' something smaller than 1 inch increments.
X = PageToIndex.Index
' draw a rectangle for each page to hold the text
Set TOCEntry = ActiveDocument.Pages(1).DrawRectangle(1, X, 4, X + 1)
' write the page name in the rectangle
TOCEntry.Text = PageToIndex.Name
' add a hyperlink to point to the page to you can just go there
' with a click
' need to create a handle to add the hyperlink
Set hlink = TOCEntry.AddHyperlink
' add a description
hlink.Description = PageToIndex.Name
' add the page name as an address
hlink.SubAddress = PageToIndex.Name
Next
End Sub
Table of Contents: Create a Table of Contents with Goto Page links. This is my version of Zack’s program.
Код:
Sub TableOfContents()
' creates a shape for each page in the drawing on the first page of the drawing
' then add a dbl-clk GoTo to each shape so you can double click and go to that Page
Dim PageObj As Visio.Page
Dim TOCEntry As Visio.Shape
Dim CellOjb As Visio.Cell
Dim PosY As Double
Dim PageCnt As Double
' ActiveDocument.Pages.Count will give the number of pages, but we are interested
' the number of foreground pages
PageCnt = 0
For Each PageObj In ActiveDocument.Pages
If PageObj.Background = False Then PageCnt = PageCnt + 1
Next
' loop through all the pages
For Each PageObj In ActiveDocument.Pages
If PageObj.Background = False Then ' Only foreground pages
' where to put the entry on the page?
PosY = (PageCnt - PageObj.Index) / 4 + 1
' draw a rectangle for each page to hold the text
Set TOCEntry = ActiveDocument.Pages(1).DrawRectangle(1, PosY, 4, PosY + 0.25)
' write the page name in the rectangle
TOCEntry.Text = PageObj.Name
' add a link to point to the page to you can just go there with a Double Click
Set CellObj = TOCEntry.CellsSRC(visSectionObject, visRowEvent, visEvtCellDblClick) 'Start
CellObj.Formula = "GOTOPAGE(""" + PageObj.Name + """)"
End If
Next
End Sub