Generating a table from Word template userform

[johnny6]

Hello,

I have a Word 2007 template that opens a UserForm with list boxes and text boxes. The data entered into these boxes is then passed to the Word template via bookmarks.

What I am trying to figure out, if it is even possible, is how to populate a table with this data. The table will be 2 columns. Column 1 will be static text and column 2 will be the bookmarked data. The tricky part is that the number of data fields to transfer can change, and the number of rows in the table needs to change to only have the appropriate amount for the needed data. For instance, there might be 10 text boxes but if only 4 are filled out then the table should only have 4 rows.

I believe creating the table in the VB code and then putting that into a bookmark, then transferring the bookmark of the data into the Word document would be the best way.

Is something like this possible? I can find no documentation to get started. Any information would be appreciated.

[gmaxey]

Declare an array to strore the data in "filled in" text boxes only. Then use the number of array elements to determine how many rows you need. This is rough but should give you the idea:

Private Sub CommandButton1_Click()
Dim arrStr() As String
Dim i As Long
i = 0
Dim oTbl As Word.Table
If Me.TextBox1.Text <> "" Then
ReDim Preserve arrStr(i)
arrStr(i) = Me.TextBox1.Text
i = i + 1
End If
If Me.TextBox2.Text <> "" Then
ReDim Preserve arrStr(i)
arrStr(i) = Me.TextBox2.Text
i = i + 1
End If
If Me.TextBox3.Text <> "" Then
ReDim Preserve arrStr(i)
arrStr(i) = Me.TextBox3.Text
i = i + 1
End If
If Me.TextBox4.Text <> "" Then
ReDim Preserve arrStr(i)
arrStr(i) = Me.TextBox4.Text
i = i + 1
End If
If Me.TextBox5.Text <> "" Then
ReDim Preserve arrStr(i)
arrStr(i) = Me.TextBox5.Text
i = i + 1
End If
Set oTbl = ActiveDocument.Tables.Add(ActiveDocument.Bookmarks("TableLoc").Range, i, 2)
For i = 0 To UBound(arrStr)
oTbl.Cell(i + 1, 2).Range.Text = arrStr(i)
Next i
End Sub

[johnny6]

Greg,

Thank you so much; that is exactly what I was looking for.

A couple follow-up questions if you don't mind.

To get column 1 populated with the name of the text box, I pretty much doubled everything. It is working, but it seems messy and there is probably a much more elegant solution. What do you think? Here is what I have now:

Dim arrTab1() As String
Dim arrTab2() As String
Dim o As Long
Dim i As Long
i = 0
o = 0
Dim oTbl As Word.Table
If varText1 <> "" Then
ReDim Preserve arrTab1(i)
arrTab1(i) = varText1
ReDim Preserve arrTab2(o)
arrTab2(o) = "Text 1"
i = i + 1
o = o + 1
End If
If varText2 <> "" Then
ReDim Preserve arrTab1(i)
arrTab1(i) = varText2
ReDim Preserve arrTab2(o)
arrTab2(o) = "Text 2"
i = i + 1
o = o + 1
End If
If varText3 <> "" Then
ReDim Preserve arrTab1(i)
arrTab1(i) = varText3
ReDim Preserve arrTab2(o)
arrTab2(o) = "Text 3"
i = i + 1
o = o + 1
End If
If varText4 <> "" Then
ReDim Preserve arrTab1(i)
arrTab1(i) = varText4
ReDim Preserve arrTab2(o)
arrTab2(o) = "Text 4"
i = i + 1
o = o + 1
End If
Set oTbl = ActiveDocument.Tables.Add(ActiveDocument.Bookmarks("bmTableLoc").Range, i, 2)
For i = 0 To UBound(arrTab1)
oTbl.Cell(i + 1, 2).Range.Text = arrTab1(i)
Next i
For o = 0 To UBound(arrTab2)
oTbl.Cell(o + 1, 1).Range.Text = arrTab2(o)
Next o

Another thing I can't seem to figure out is the formatting of the table. The above code returns a table with no border. If I change the Set line to read
Set oTbl = ActiveDocument.Tables.Add(ActiveDocument.Bookmarks("bmTableLoc").Range, i, 2, wdTableFormatWeb1)
it is not working correctly. It changes from no border to the standard border, so I know it is doing something but it is definitely not the border for Web1 style. I also tried wdTableFormatElegant and some others but they all return the same, plain border. What am I doing wrong?

I really appreciate your time.

[johnny6]

I figured out the formatting issue.

Set oTbl = ActiveDocument.Tables.Add(ActiveDocument.Bookmarks("bmTableLoc").Range, i, 2)
With ActiveDocument.Tables(1)
.Style = "Colorful List - Accent 2"
.ApplyStyleHeadingRows = True
.ApplyStyleFirstColumn = False
End With

Now my table is pretty!

This is the first time I was actually able to solve my problem by recording a macro.

[gmaxey]

If it works it might not matter if it is messy or now ;-)

You could use a multi-demensional array. The problem is the you loose the ability to ReDim Preserve. This means that you must first determine the size of the array:

Private Sub CommandButton1_Click()
Dim arrTab1() As String
Dim oCtr As Control
Dim i As Long
i = 0
Dim oTbl As Word.Table
For Each oCtr In Me.Controls
Select Case oCtr.Name
Case "TextBox1", "TextBox2", "TextBox3", "TextBox4"
If Me.Controls(oCtr.Name).Text <> "" Then
i = i + 1
End If
End Select
Next oCtr
ReDim arrTab1(i - 1, 1)
i = 0
If Me.TextBox1 <> "" Then
arrTab1(i, 0) = Me.TextBox1
arrTab1(i, 1) = "Text Box 1"
i = i + 1
End If
If Me.TextBox2 <> "" Then
arrTab1(i, 0) = Me.TextBox2
arrTab1(i, 1) = "Text Box 2"
i = i + 1
End If
If Me.TextBox3 <> "" Then
arrTab1(i, 0) = Me.TextBox3
arrTab1(i, 1) = "Text Box 3"
i = i + 1
End If
If Me.TextBox4 <> "" Then
arrTab1(i, 0) = Me.TextBox4
arrTab1(i, 1) = "Text Box 4"
i = i + 1
End If
Set oTbl = ActiveDocument.Tables.Add(ActiveDocument.Bookmarks("TableLoc").Range, i, 2)
For i = 0 To UBound(arrTab1)
oTbl.Cell(i + 1, 2).Range.Text = arrTab1(i, 0)
oTbl.Cell(i + 1, 1).Range.Text = arrTab1(i, 1)
Next i
End Sub