VBA与Visio 2016-目录

我有一个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
yao02fei15la 回答:VBA与Visio 2016-目录

暂时没有好的解决方案,如果你有好的解决方案,请发邮件至:iooj@foxmail.com
本文链接:https://www.f2er.com/2968583.html

大家都在问