TOB Builder with Custom Page Numbers

[Scott10284]

Hello,

I am having issues with extracting page number shape data that I need to display on my table of contents.

I found some VBA programs and modified them to fit my needs. Any program that I found to date builds the TOC and sequentially numbers the pages 1,2,3,4....

I need to have the ability to define the page numbers but I cannot get the TOC Builder VBA code to cooperate with me.

I have attached a visio file that has a few pages with numbers already set up and the macro which holds the TOC builder code. I have programmed these page number shapes to hold data that I could hopefully extract through my TOB Builder VBA program.

For this to work the way I need it to my TOC would be displayed as follows:

1       Cover Page
2       Table of Contents
5.A    Test A
10.B  Test B
12.C  Test C

If anyone could help me with this I would greatly appreciate it. Thank you very much in advance.

Scott

[wapperdude]

Hi Scott,
Did you check these links:
http://visguy.com/vgforum/index.php?topic=7393.msg31126#msg31126
http://visguy.com/vgforum/index.php?topic=6250.msg29081#msg29081

Wapperdude

[Scott10284]

Wapperdude,

I did play around with the couple attachment you referred me to, but the functions are not quite what I am looking for.

My TOC builder is quite simple, the only part I cannot figure our is how to extract shape data from each page and write it to the TOC.

Scott

[wapperdude]

Can you upload vsd and vss versions?

Wapperdude

[Scott10284]

Wapperdude, attached are the VSD and VSS files.

Thanks for the help!!!!

[wapperdude]

There are a variety of ways to do TOC.  Don't know if V2010 and newer have a straight forward procedure.

But, here's a simple example for a simple basic TOC.  It captures the page name and page number.  Creates a list in a single shape.  At least, you can examine the code to see how to capture these values.

Code Select Expand


Public Sub TOC()
 
    Dim pgCnt As Integer
    Dim vsoChars As Characters
    Dim vsoPgs As Visio.Pages
    Dim tocShp As Shape
    Dim tocChrs As Characters
    Dim tocTxt As String

'Get the Pages collection for the active document.
    Set vsoPgs = ActiveDocument.Pages
 
'Setup index shape formating:  tab position, tab alignment, initial text placement
'Assumes the macro is run from the TOC page.
'Assumes the TOC shape is sheet.2

    Set tocShp = ActivePage.Shapes.ItemFromID(2)
    tocShp.CellsSRC(visSectionObject, visRowText, visTxtBlkDefaultTabStop).FormulaU = "3.5"
    tocShp.CellsSRC(visSectionTab, 0, visTabAlign).FormulaU = "2"
    Set vsoChars = tocShp.Characters
    vsoChars.End = vsoChars.CharCount + 1
   
'Go thru pages, get names and numbers, insert info into Table of Contents shape.
      For Each vsoPg In ActiveDocument.Pages
        tocTxt = vsoPg.Name & Chr(9) & vsoPg.Index
        vsoChars.Text = tocTxt & Chr(10)
        Set vsoChars = tocShp.Characters
        vsoChars.Begin = vsoChars.CharCount
        vsoChars.End = vsoChars.Begin + 1
    Next vsoPg

End Sub

Enjoy.
wapperdude

[Scott10284]

Wapperdude,

I have seen many TOC builders that sequentially number the pages 1,2,3,... like this one.

For my application, I need to have the ability to arbitrarily assign page numbers like 2.A, 5.D, and so forth.

So I added data to my page numbers on each page. I am attempting to extract that shape data and write it into my TOC builder but have had no success.

Any suggestions on how I can extract the random page number shape data and write them to my TOC?

[wapperdude]

OK.  I missed what you were doing.  The code has been updated.  It allows the option to use either traditional page numbering or your special page number shape.  I specifically renamed that shape, so the program knows what to look for.  The "IF" statement checks for the presence of this shape.  Use whatever name you want for the shape, and modify the code.
 
Here's the code:

Code Select Expand


Public Sub TOC()
 
    Dim pgCnt As Integer
    Dim vsoChars As Characters
    Dim vsoPgs As Visio.Pages
    Dim tocShp As Shape
    Dim tocChrs As Characters
    Dim tocTxt As String

'Get the Pages collection for the active document.
    Set vsoPgs = ActiveDocument.Pages
 
'Setup index shape formating:  tab position, tab alignment, initial text placement
'Assumes the macro is run from the TOC page.
'Assumes the TOC shape is sheet.2

    Set tocShp = ActivePage.Shapes.ItemFromID(2)
    tocShp.CellsSRC(visSectionObject, visRowText, visTxtBlkDefaultTabStop).FormulaU = "3.5"
    tocShp.CellsSRC(visSectionTab, 0, visTabAlign).FormulaU = "2"
    Set vsoChars = tocShp.Characters
    vsoChars.End = vsoChars.CharCount + 1
   
'Go thru pages, get names and numbers, insert info into Table of Contents shape.
      For Each vsopg In ActiveDocument.Pages
      On Error Resume Next
        If vsopg.Shapes.ItemU("PagNum").CellsU("Prop.PgNum") = "" Then
            pgNum = vsopg.Index
        Else
            pgNum = vsopg.Shapes.ItemU("PagNum").CellsU("Prop.PgNum").ResultStr(Visio.visNone)
        End If
       
        tocTxt = vsopg.Name & Chr(9) & pgNum
        vsoChars.Text = tocTxt & Chr(10)
        Set vsoChars = tocShp.Characters
        vsoChars.Begin = vsoChars.CharCount
        vsoChars.End = vsoChars.Begin + 1
    Next vsopg

End Sub

Wapperdude

[Scott10284]

Works like a charm.

THANK YOU Wapperdude.