auto table of contents in publisher??

[scott]

Is there the functionality to create a TOC in publisher
that can be linked to Heading styles or something like is
avail. in MS Word.

thanks in advance

Scott

[Bastet]

Nope.

[°°°MS°Publisher°°°]

No, create it in Word or do it manually which really is the answer if you
want a top class job.

--

[made...@gmail.com]

Hi,
I had to write my own code to build an automatic "table of contents" macro.
It looks for every paragraph written with a specific style "Título 1"
It allows three levels of grouping shapes within a page and the results is a TXT file with paragraph contents and page numbers.
I hope you enjoy it.

Public Lineas(1000) As String
Public Pags(1000) As Integer
Public x As Long
Public Estilo As String
Public Pagina As String

Sub Indice()
Dim pbPage As Page
Dim pbShape As Shape
Dim pbShapeI As Shape
Dim pbShapeII As Shape
Dim pbShapeIII As Shape

Estilo = "Título 1"
x = 0
For Each pbPage In ActiveDocument.Pages
'Application.StatusBar = "Página: " & pbPage.PageNumber
Pagina = pbPage.PageNumber
For Each pbShape In pbPage.Shapes
If pbShape.HasTextFrame Then
Call CheckShape(pbShape)
Else
If pbShape.Type = pbGroup Then
For Each pbShapeI In pbShape.GroupItems
If pbShapeI.HasTextFrame Then
Call CheckShape(pbShapeI)
Else
If pbShapeI.Type = pbGroup Then
For Each pbShapeII In pbShape.GroupItems
If pbShapeII.HasTextFrame Then
Call CheckShape(pbShapeII)
Else
If pbShapeII.Type = pbGroup Then
For Each pbShapeIII In pbShape.GroupItems
If pbShapeIII.HasTextFrame Then
Call CheckShape(pbShapeIII)
End If
Next pbShapeIII
End If
End If
Next pbShapeII
End If
End If
Next pbShapeI
End If
End If
Next pbShape
Next pbPage
'Writing TOC in a txt file
Nfile = Application.ActiveDocument.Path & "/INDICE" & Application.ActiveDocument.Name & ".txt"
Open Nfile For Output As #1
For x = 1 To 1000
Write #1, Lineas(x) & "." & Pags(x)
Next x
Close #1
End Sub

Sub CheckShape(SShape As Shape)
If SShape.TextFrame.HasText Then
If SShape.TextFrame.TextRange.Paragraphs(1).ParagraphFormat.TextStyle = Estilo Then
x = x + 1
Lineas(x) = SShape.TextFrame.TextRange.Paragraphs(1).Text
Pags(x) = Pagina
End If
End If
End Sub