Add rows to word table from userform code

[tbransco]

Hello,

I want to use code located in a userform to add a blank row to a table in my document, but Word refuses to cooperate, informing me that some or all of the selection (?) is not within the table (runtime error 4605). Makes me think table cannot be manipulated from within a userform. Anyway, there is a single table in my document (generated from a template) which starts with two rows each time the document is generated from an underlying template.

The userform code is located within a command button Click event handler:


Private Sub cmdAdd_Click()

Dim intLastRow As Integer
Dim objTable As Word.Table

' if there is data in the first column of the last row, add a new row to the table
Set objTable = ActiveDocument.Tables(1)
With objTable
intLastRow = .Rows.Count
If Len(.Cell(intLastRow, 0).Range.Text) > 0 Then
.Rows.Add <----------------- Error 4605 triggered
End If
End With
Set objTable = Nothing


If anyone can guide me to the appropraite syntax, i'd sure appreciate it!

Thanks,
Terry

[fumei]

I copied your code exactly. I get no error.

Comments:

As written the code ALWAYS makes a new row regardless of the content of the cell. Text or no text, the code always makes a new row. This because


Len(.Cell(intLastRow, 0).Range.Text)

is always greater than zero. Len of a blank cell.range.text always = 2. The range of a cell includes the end-of-cell marker, a unique two character object consisting of ASCII 13 (carriage return) and ASCII 7 (bell) - the sound typewriters made when they did a carriage return.

[tbransco]

Thanks, fumei.

Good to know about the end-of-cell marker contents. I'll adjust my checks for empty cells accordingly, and retry my code in a new document to eliminate any interference from other code bits in my project.

Kind of you to respond!
Terry

[tbransco]

Hmm.

I seem to be left with the same Error 4605 in my original document, despite the fact I too verified the identical code does work when its copied to another document. I just can't see what a 'selection' has to do with it since I don't have anything selected in the document.

Terry

[fumei]

Impossible for us to say. Unless of course you post your full code, or a document file that shows the behaviour.

[tbransco]

OK, thanks again for sticking with me!

My userform code follows, and it's called by a macro in a standard module that's configured as a formfield OnExit macro.


Option Explicit
Private mavarWellData As Variant
Private mintFoundWells As Integer
Private mbooEntryError As Boolean

Private Sub UserForm_Initialize()
Me.SetDefaultTabOrder
' When this userform is activated from within the document, set the Title textbox to the value in the document's TitleNum formfield;
' otherwise, leave the Title textbox blank
If Len(Trim(ActiveDocument.FormFields("FileNum").Result)) > 0 Then
Me.txbTitle.Text = Trim(ActiveDocument.FormFields("FileNum").Result)
End If
Me.cmdAdd.Enabled = False
End Sub 'UserForm_Initialize

Private Sub cmdCancel_Click()
' click on the CANCEL button to close the form

Me.txbTitle.Text = ""
Me.txbCancDt.Text = ""
Me.lisWells.Clear
Unload Me
End Sub 'cmdCancel_Click

Private Sub txbTitle_Enter()
With txbTitle
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub 'txbTitle_Enter

Private Sub txbTitle_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
' retrieve and display the cancellation date and any associated wells remaining on title for the cancelled titles
Dim strTitle As String
Dim strSQL As String

mbooEntryError = False

If Len(Trim(Me.txbTitle.Text)) = 0 Then
Beep
mbooEntryError = True
MsgBox "Please enter a title number, or click Cancel to finish.", vbInformation
End If

If Not IsNumeric(Me.txbTitle.Text) Then
Beep
mbooEntryError = True
MsgBox "Invalid title number format. Please enter integers only.", vbInformation, "Invalid title number"
End If
End Sub 'txbTitle_BeforeUpdate

Private Sub txbTitle_Exit(ByVal Cancel As MSForms.ReturnBoolean)
' Retrieve and display the title and well information based on the input title
Dim i As Integer
Dim strSQL As String
Dim strList As String
Dim strTitle As String
Dim strCancelDate As String

'If the title value is invalid, stop everything
If mbooEntryError Then Exit Sub

' Retrieve the title cancellation date and update the userform directly
strTitle = Me.txbTitle.Text
If Not IsCancelled(strTitle) Then
MsgBox "Sorry, that's not a cancelled title. Please try again.", vbInformation
Exit Sub
End If
With Me.cmdAdd
.Enabled = True
.SetFocus
End With
strCancelDate = Format(GetCancelDate(strTitle), "yyyy-mmm-d")
Me.txbCancDt.Text = strCancelDate

' Retrieve any well permits associated with this well, and store them in an array
Set grstIPS = New adodb.Recordset
strSQL = "SELECT T1.WA_NUMBER FROM IPS.IPS_TITLE_WELL T1 " & _
" WHERE T1.TITLE_NUMBER_ID = " & strTitle

grstIPS.Open _
Source:=strSQL, _
ActiveConnection:=gcnnIPS, _
CursorType:=adOpenStatic, _
LockType:=adLockReadOnly

If grstIPS.RecordCount = 0 Then ' if there are no wells found
Beep
GoTo CleanUp
End If
mintFoundWells = grstIPS.RecordCount

ReDim mavarWellData(grstIPS.RecordCount - 1, 1) As Variant
With grstIPS
.MoveFirst
For i = LBound(mavarWellData) To UBound(mavarWellData)
mavarWellData(i, 0) = grstIPS.Fields(0).Value
strList = strList & Chr(39) & mavarWellData(i, 0) & Chr(39)
If i < UBound(mavarWellData) Then
strList = strList & ","
End If
.MoveNext
Next i
End With

Set grstIPS = Nothing

' Retrieve the well name of these same wells
Set grstIPS = New adodb.Recordset
strSQL = "SELECT W1.WELL_NAME " & _
" FROM IPS.IPS_WELL_MVW W1 " & _
" WHERE W1.WA_NUMBER IN (" & strList & ")"

grstIPS.Open _
Source:=strSQL, _
ActiveConnection:=gcnnIPS, _
CursorType:=adOpenStatic, _
LockType:=adLockReadOnly

If grstIPS.RecordCount = 0 Or IsNull(grstIPS.Fields(0).Value) Then
Beep
MsgBox "Cannot retrieve wellnames from IPS_WELL_MVW", vbCritical, "ERROR"
GoTo CleanUp
End If

ReDim Preserve mavarWellData(mintFoundWells - 1, 1) As Variant
With grstIPS
.MoveFirst
For i = 0 To mintFoundWells - 1
mavarWellData(i, 1) = grstIPS.Fields(0).Value
.MoveNext
Next i
End With

' Display the well data
Me.lisWells.List = mavarWellData
CleanUp:
grstIPS.Clone
Set grstIPS = Nothing

End Sub 'txbTitle_AfterUpdate
Private Sub cmdAdd_Click()
' click the [Add Title to Letter] button to accept this well and add it to the letter
Dim i As Integer
Dim intLastRow As Integer
Dim objTable As Word.Table
Dim strWellData As String

' if there is data in the first column of the last row, add a new row to the table
Set objTable = ActiveDocument.Tables(1)
With objTable
intLastRow = .Rows.Count
If Len(Trim(.Cell(intLastRow, 0).Range.Text)) - 2 > 0 Then ' end-of-cell marker
.Rows.Add '<----------------- Error 4605 triggered
End If
End With
Set objTable = Nothing

Call UnlockDoc
ActiveDocument.Tables(1).Cell(intLastRow, 1).Range.Text = Me.txbTitle.Text
' Insert the cancellation date
ActiveDocument.Tables(1).Cell(intLastRow + 1, 2).Range.Text = Me.txbCancDt
If mintFoundWells > 0 Then
'Insert the well permit number and wellname
For i = LBound(mavarWellData) To UBound(mavarWellData)
strWellData = strWellData & "WA " & mavarWellData(i, 0) & Space(10) & mavarWellData(i, 1) & vbCr
Next i
ActiveDocument.Tables(1).Cell(intLastRow, 3).Range.Text = strWellData
End If
Call LockDoc

Me.txbTitle.Text = ""
Me.txbCancDt.Text = ""
Me.lisWells.Clear
Me.cmdCancel.SetFocus
End Sub 'cmbAdd_Click

[fumei]

formfield OnExit macro
Then the Selection is still there...outside the table I assume, although you do not state this. WHERE is the formfield?

[tbransco]

Thanks, fumei.

Yes, that's correct. The formfield is in the body of the document template, and the table is further down the page. I did think of moving the selection into the table, but was not successful in my attempts to do so from the userform, or the problem was not precisely as the error message describes it. I've removed my trial code, but I believe I tried this:



ActiveDocument.Tables(1).Cells(0,0).Range.Select.Collapse


Terry

[tbransco]

:hi:

fumei,

I want to thank you again for leading me by the nose to the solution: moving the insertion point to the table BEFORE calling the userform.

Cheers,

Terry

[fumei]

And there you go.