VBA与Visio2016目录

我有一个200页的visio文件，我很想为其提供一份目录，因此我正在尝试VBA。虽然我不知道为什么我的容器没有装满，但我还是被卡住了。运行它时没有调试消息。感谢您的帮助。

Sub TableOfContents()
'Autumn's First VB Script
'woot woot
'Name some stuff
Dim vsoDocument As Visio.Document
Dim TOCPage As Visio.Page
Dim APage As Visio.Page
Dim TOCContainer As Visio.Shape
Dim TOCEntry As Visio.Cell
'Dim ACell As Cell
'Set focus on TOCPage
Visio.Application.activeWindow.Page = "TOCPage"
'Insert Container
If Not (TOCContainer Is Nothing) Then
Set vsoDocument = Application.Documents.OpenEx(Application.GetBuiltInStencilFile(visBuiltInStencilContainers,visMSUS),visOpenDocked)
Application.activePage.DropContainer vsoDocument.Masters.ItemU("TOCContainer"),Application.activeWindow.Selection
'make container type a list
Set TOCContainer.visCOntainerTypelist= "1"
'Fill cells with a loop through the pages
For Each APage In activeDocument.Pages
'no background pages
If APage.Background = False Then
'no idea what this does
'PosY = (PageCnt - APage.Index) / 4 + 1
'add members in container via loop
Call TOCContainer.ContainerProperties.AddMember(TOCEntry,visMemberAddExpandContainer)
'add the page names to the members
TOCEntry.Text = APage.Name
'Hyperlink cells
Set TOCCell = TOCEntry.CellsSRC(visSectionObject,visRowEvent,visEvtCellDblClick) 'Start
TOCCell.Formula = "GOTOPAGE(""" + APage.Name + """)"
'Format cells
TOCEntry.Cells("char.Size").Formula = "12 pt"
TOCEntry.Cells("char.color").Formula = "RGB(0,0)"
TOCEntry.Cells("FillForegnd").Formula = "RGB(255,255,255)"
Else
Debug.Print "Page is background"
End If
Next
vsoDocument.Close
Else
Debug.Print "Container is here"
End If
End Sub