Creating tables in loop

[tborthwick]

Hello,

I'm trying to loop through some information, creating some text and a
table at each pass. What I have now (see below) places each table into
the first cell of the preceding table. It probably is an error in my
range but I'm not sure what it should look like. I thought using
Collapse would position the range at the current insertion point but
it doesn't seem to. Any help would be appreciated.

Thanks,

Tom


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

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)

Word.Selection.TypeText Text:=ent.EntityName & vbCrLf
Word.Selection.TypeText Text:=ent.Note & vbCrLf

Set objRange = Word.Selection.Range
objRange.Collapse Direction:=0

Set objTable = objRange.Tables.Add(Range:=objRange,
NumRows:=ent.Attributes.Count, NumColumns:=3)

Dim curRow As Integer
curRow = 1

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

curRow = curRow + 1
Next
objRange.Collapse Direction:=0
objRange.Select()

End If
Next
End Sub

 

[Doug Robbins - Word MVP]

Declare a Range object

Dim myrnge as Range

Then

For Each so In sm.SelectedObjects
If so.Type = 1 Then
id = so.ID
Set ent = mdl.Entities.Item(id)
Set myrnge = ActiveDoc.Range
myrange.Collapse wdCollapseEnd
myrange.InsertAfter ent.EntityName & vbCrLf & ent.Note & vbCrLf
Set myrnge = ActiveDoc.Range
myrnge.Collapse wdCollapseEnd
Set objTable = objRange.Tables.Add(Range:=myrnge, _
NumRows:=ent.Attributes.Count, NumColumns:=3)

'etc

End If
Next


--
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