table of contents

[tborthwick]

Hello,

I'm trying to add a table of contents to the word doc my script below
is generating. In the body of the script, I try to mark each entity
name as a TOC entry, then add the TOC to the doc at the end. All I get
is a 'No table of contents found' inserted into my doc. Do I need to
apply a style to the text I want to be toc entries or is there a
problem with the ranges? Any help would be appreciated.

Thanks,

Tom


'MACRO TITLE: EXPORT MODEL META DATA TO WORD


Dim attr As AttributeObj
Dim myRange As Object

Sub Main

Dim Word As Object
Dim Docs As Object
Dim WordBasic As Object
Dim ActiveDoc As Object

Dim diag As Diagram
Dim mdl As Model
Dim sm As SubModel
Dim so As SelectedObject
Dim id As Integer
Dim ent As Entity
Dim attr As AttributeObj
Dim tableCount As Integer

Set Word = CreateObject("Word.Application")
Word.Visible = True
Word.Options.CheckGrammarAsYouType = False
Word.Options.CheckSpellingAsYouType = False

Set ActiveDoc = Word.Documents.Add()

Set diag = DiagramManager.ActiveDiagram
Set mdl = diag.ActiveModel
Set sm = mdl.ActiveSubModel

For Each so In sm.SelectedObjects
If so.Type = 1 Then
id = so.ID
Set ent = mdl.Entities.Item(id)

Set myRange = ActiveDoc.Range
myRange.Font.Size = 12
myRange.Collapse 0
myRange.InsertAfter ent.EntityName & vbCrLf
ActiveDoc.TablesOfContents.MarkEntry Range:=myRange, _
Level:=1, Entry:=ent.EntityName

If ent.Definition <> "" Then
Set myRange = ActiveDoc.Range
myRange.Collapse 0
'myRange.Font.Size = 10

myRange.InsertAfter ent.Definition & vbCrLf
End If

Set myRange = ActiveDoc.Range
'myRange.Font.Size = 10
myRange.Collapse 0
Set objTable = myRange.Tables.Add(Range:=myRange,
NumRows:=ent.Attributes.Count, NumColumns:=3)

Dim curRow As Integer
curRow = 1

'Add column headings
objTable.Cell(curRow, 1).Range.Text = "Column name"
objTable.Cell(curRow, 2).Range.Text = "Datatype"
objTable.Cell(curRow, 3).Range.Text = "Definition"
curRow = curRow + 1

For Each attr In ent.Attributes
objTable.Cell(curRow, 1).Range.Text = attr.ColumnName
objTable.Cell(curRow, 2).Range.Text = Datatype(attr.Datatype,
attr.DataLength)
objTable.Cell(curRow, 3).Range.Text = attr.Definition

curRow = curRow + 1
Next

'4, 27, 36
objTable.autoFormat(36)
objTable.Columns(1).Width = 135
objTable.Columns(2).Width = 80
objTable.Columns(3).Width = 235


Set myRange = ActiveDoc.Range
myRange.Collapse 0
myRange.InsertAfter vbCrLf

End If
Next

For Each table In ActiveDoc.Tables

table.Range.Font.Size = 10
table.Cell(1,1).Range.Font.Bold = True
table.Cell(1,2).Range.Font.Bold = True
table.Cell(1,3).Range.Font.Bold = True
table.Cell(1,1).Shading.BackgroundPatternColorIndex = 475
table.Cell(1,2).Shading.BackgroundPatternColorIndex = wdGray25
table.Cell(1,3).Shading.BackgroundPatternColorIndex = wdGray25
Next

Set tocRange = ActiveDoc.Range(Start:=0, End:=0)
ActiveDoc.TablesOfContents.Add Range:=tocRange, _
UseFields:=False, UseHeadingStyles:=True, _
LowerHeadingLevel:=3, _
UpperHeadingLevel:=1
ActiveDoc.TablesOfContents(1).UpdatePageNumbers

End Sub


Function Datatype ( DT As String , attr As Integer) As String

Dim test As String

test = UCase(DT)

Select Case test
'Case "VARCHAR","CHAR","NCHAR","BIT","TEXT", "DECIMAL","DECIMALN"
Case "VARCHAR","CHAR","NCHAR"
Dim dataLength As String
dataLength = Str(attr)
Datatype = DT & "(" & dataLength & ")"

Case Else
Datatype = DT
End Select

End Function

 

[Doug Robbins - Word MVP]

The code that you are using to create the Table of Contents is relying on
the presence of Heading Styles in the document (Specifically, the styles
Heading 1, Heading 2 and Heading 3, though the presence of not all of those
heading levels would be required, but at least one of them must be.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[Jay Freedman]

If you want to use only the TC fields inserted by the macro (the
ActiveDoc.TablesOfContents.MarkEntry statement), then change the parameters
of the ActiveDoc.TablesOfContents.Add statement to

UseFields:=True, UseHeadingStyles:=False, _

or you can set both parameters to True to use both TC fields and heading
styles. Another bit: If you use TC fields only, then you don't need to set
the LowerHeadingLevel and UpperHeadingLevel parameters because they'll be
ignored.

--
Regards,
Jay Freedman
Microsoft Word MVP
Email cannot be acknowledged; please post all follow-ups to the newsgroup so
all may benefit.

 

[tborthwick]

Thanks, that makes sense. Another related question...When I try to use
heading styles rather than TC fields, I can't seem to apply the
heading style to just the entity name without also including the
paragraph that follows. The portion of the script looks like-

For Each so In sm.SelectedObjects
If so.Type = 1 Then
id = so.ID
Set ent = mdl.Entities.Item(id)
Set myRange = ActiveDoc.Range
myRange.Style = "Heading 2"
myRange.Collapse 0
myRange.InsertAfter ent.EntityName & vbCrLf

If ent.Definition <> "" Then
Set myRange = ActiveDoc.Range
myRange.Collapse 0
myRange.Font.Size = 10
myRange.InsertAfter ent.Definition & vbCrLf
End If
.....<loop continues>...

I clearly don't understand what the range object is doing. What do I
need to do to apply a different style to the entity definition
paragraph? Instead of getting a font size of 10, it picks up the
heading style defined on the entity name. Thanks for the help,

Tom

 

[Jay Freedman]

I think the point of confusion here is that the InsertAfter method of a
Range object doesn't work quite like typing on the keyboard at the same
location. In the user interface you can override the font formatting of the
current paragraph style, for instance by changing the font size, and then
start to type; the new text will pick up the direct formatting instead of
the underlying style's definition. That isn't true for the InsertAfter
method. To do something similar with a Range, you have to insert the text
and _then_ apply formatting.

The real issue, though, is that you shouldn't be applying direct formatting
to the entity definition at all. In the template that you use to create the
document, define the Normal style (or whatever you use for a base style,
such as Body Text) to have the 10 pt font size. Let your macro apply Heading
2 style to the entity name after it's inserted, and don't touch the
formatting of the entity definition.

Here's some sample code, which assumes that the base style is already 10 pt.

For Each so In sm.SelectedObjects
If so.Type = 1 Then
ID = so.ID
Set ent = mdl.Entities.Item(ID)
Set myRange = ActiveDoc.Range
With myRange
.Collapse wdCollapseEnd
.Text = ent.EntityName & vbCrLf
' At this point myRange has the base style
' of the document.

' Move the end of the range one character
' back toward the start, so it doesn't
' include the paragraph mark (vbCrLf), only
' the EntityName.
.MoveEnd unit:=wdCharacter, Count:=-1

' Apply the style to only the EntityName.
.Style = "Heading 2"
End With

If ent.Definition <> "" Then
Set myRange = ActiveDoc.Range
With myRange
.Collapse wdCollapseEnd
.Text = ent.Definition & vbCrLf
' This text will have the base style.
End With
End If
End If
....<loop continues>...