Creating tables in loop   

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

date: Mon, 10 Mar 2008 15:04:50 -0700 (PDT)   author:   unknown

Re: Creating tables in loop   

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

 wrote in message 
news:b1c91e8f-aca8-49c3-be51-ceca985d964f@13g2000hsb.googlegroups.com...
> 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

date: Tue, 11 Mar 2008 17:19:00 +1000   author:   Doug Robbins - Word MVP