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