Quote:
> Hi Corey,
> Maybe the following does the trick for you??
> Dim oTbl As Table
> Set oTbl = ActiveDocument.Tables(1)
> With oTbl
> .Rows.Add
> With .Rows(.Rows.Count)
> .Height = 12
> .Cells(1).Range.Text = "Testing"
> End With
> End With
> HTH
Thanks for the response Dave.
Unfortunately that didn't help. I've included below a copy of a new
pmessage I just posted which explains my problem better (I think).
I've changed the code so that it actually runs through a userform
(instead of just testing the code through a command button). I hope
you can follow exactly what is going on by my description (hard to
explain in words, easier to see it in action)!
--------------------------
Hello. Here's my problem:
I have a 7-column table, with just one row (containing the column
headings). I use VBA to add a new row to this table, and textboxes on
a userform to populate the cells of the table. I also use code to
limit the total height of the table (by counting the height of each
row). All the code (add row, check row height, insert data into
cells) is run through a command button on the userform.
My userform has three command buttons: one to add the new
row/inforamtion and then continue, one to add the row/info and stop,
and one to cancel/unload the form.
My problem is with how Word is treating the height of the table rows.
When i add new data, no matter how much data I enter into the textbox,
the new row is added properly with the row height set to fit all the
data as needed (height increases if the text needs to wrap in the
table cell). Now, for some reason, as I add more rows, the height of
the third row up (not the new added row, or the row above the new one,
but the one aboe THAT one) changes! it becomes quite small (just
enough to fit one row of text), thus hiding some of the info in the
cells if the text has had to wrap. Even the row with the column
headings is changed (once I add a second row - for a total of three
row).
For instance (pretend the table rows are numbered, starting from 1):
If you have added 10 rows of data (for a total of 11 rows), all but
the last two rows (rows 10 and 11) are having their row heights
changed by my code (I don't want this to happen!). [Each time it is
the third row up is changed]. If you then add another row (total of
12), it changes the row height of row 10 to a smaller height so that
only rows 11 and 12 are as they should be. The best way to visualize
it is to make a empty 7-column,1-row table and try the code I guess.
Basically, I want each row to automatically resize to fit the amount
of text entered through the userform for that particular cell. Some
rows may be small, some may be large.
Also, is there any other way I can limit the vertical size of the
table other than by adding the individual row heights? (I think my
problem may be rooted in the height rule portions of the code - in
order to get the height as defined, I need to set the height rule to
exactly instead of auto).
Any help/insight is appreciated!
Here's my code:
-----------
Option Explicit
Private Sub AddButton_Click()
Dim TotalHeight1 As Single
Dim myTable1 As Table
Dim NewRow1 As Variant
Dim RowCount1 As Integer
Dim LastRow1 As Variant, c As Integer, AddRowCheck1 As Variant
' Reference the first table in the document.
Set myTable1 = ActiveDocument.Tables(1)
RowCount1 = myTable1.Rows.Count
' get total height of table
For c = 1 To RowCount1
myTable1.Rows(c).HeightRule = wdRowHeightExactly
TotalHeight1 = TotalHeight1 + myTable1.Rows(c).Height
Next c
' get height of last row
AddRowCheck1 = TotalHeight1 + myTable1.Rows(RowCount1).Height
myTable1.Rows(RowCount1).HeightRule = wdRowHeightAuto
If AddRowCheck1 < 135 Then ' 1.87 inches * 72 to convert to
points
' add new row
Set NewRow1 = myTable1.Rows.Add
LastRow1 = myTable1.Rows.Count
myTable1.Rows(LastRow1).HeightRule = wdRowHeightAtLeast
' using Auto in the above line of code doesn't work either!
' Fill in the table row
myTable1.Cell(LastRow1, 1).Range.Text = txtTestNo.Value
myTable1.Cell(LastRow1, 2).Range.Text = txtLocation.Text
myTable1.Cell(LastRow1, 3).Range.Text = txtDryWt.Value
myTable1.Cell(LastRow1, 4).Range.Text = txtMC.Value
myTable1.Cell(LastRow1, 5).Range.Text = txtProctor.Value
myTable1.Cell(LastRow1, 6).Range.Text = txtOptMC.Value
myTable1.Cell(LastRow1, 7).Range.Text = txtDensity.Value
Else
' dont add row and give msgbox instead
MsgBox "There are too many rows! Start a new file!"
End If
' reset variable counters
RowCount1 = 0
TotalHeight1 = 0
AddRowCheck1 = 0
LastRow1 = 0
' reset values in textbox on form to null
txtTestNo.Value = ""
txtLocation.Text = ""
txtDryWt.Value = ""
txtMC.Value = ""
txtProctor.Value = ""
txtOptMC.Value = ""
txtDensity.Value = ""
End Sub
Private Sub CancelButton_Click()
Unload frmDensities
End Sub
Private Sub DoneButton_Click()
' same code a above, but unloads userform after adding info
Dim TotalHeight1 As Single
Dim myTable1 As Table
Dim NewRow1 As Variant
Dim RowCount1 As Integer
Dim LastRow1 As Variant, c As Integer, AddRowCheck1 As Variant
' Reference the first table in the document.
Set myTable1 = ActiveDocument.Tables(1)
RowCount1 = myTable1.Rows.Count
' get total height of table
For c = 1 To RowCount1
myTable1.Rows(c).HeightRule = wdRowHeightExactly
TotalHeight1 = TotalHeight1 + myTable1.Rows(c).Height
Next c
' get height of last row
AddRowCheck1 = TotalHeight1 + myTable1.Rows(RowCount1).Height
If AddRowCheck1 < 135 Then ' 1.87 inches * 72 to convert to
points
' add new row
Set NewRow1 = myTable1.Rows.Add
LastRow1 = myTable1.Rows.Count
myTable1.Rows(LastRow1).HeightRule = wdRowHeightAtLeast
' using Auto doesn't work either!
' Fill in the table row
myTable1.Cell(LastRow1, 1).Range.Text = txtTestNo.Value
myTable1.Cell(LastRow1, 2).Range.Text = txtLocation.Text
myTable1.Cell(LastRow1, 3).Range.Text = txtDryWt.Value
myTable1.Cell(LastRow1, 4).Range.Text = txtMC.Value
myTable1.Cell(LastRow1, 5).Range.Text = txtProctor.Value
myTable1.Cell(LastRow1, 6).Range.Text = txtOptMC.Value
myTable1.Cell(LastRow1, 7).Range.Text = txtDensity.Value
Else
' dont add row and give msgbox instead
MsgBox "There are too many rows! Start a new file!"
End If
Unload frmDensities
End Sub
---------------------
Regards,
Corey Dale
remove (nospam) for email