VBA Equivelent of CalculateOnExit

G

Greg Maxey

Does anyone know a VBA equivalent command for the actions that take place
when the FormField Options Dialog "CalculateOnExit" is checked?

I am working on a fairly lengthy piece of code that involves several
formfields using "CalculateOnExit" and a fairly complex OnExit macro. The
problem I am having is that calculation fields are not being updated due to
the actions of the OnExit macro.

The calculations remain static after the OnExit macro completes. The only
way the static calculations will update is when I exit a subsequent field
that has CalculateOnExit and no OnExit routine.

I am looking for a command to run at the end of my OnExit macro that will
command the formfields to calculate like the CalculateOnExit option does.
Thanks.
 
G

Greg Maxey

This seems odd to me. My formfields are in a table and at the beginning of
the procedure I

Set pTable = Selection.Tables(1)

and I had tried

pTable.Range.Fields.Update

at the end of the procedure and the fields didn't update

I just tried

ActiveDocument.Fields.Update

at the end of the procedure and it works. The formfield calculation fields
update.

I guess I should share all the code and a full description of the process.

I am working on an invoice template. The template cosists of a table with
heading row followed by four addtional rows of four columns each.

The second row is for column headings "Item" "Price" "Qty" and "Total"

The third row has a text formfield in column 1 "Item" a text formfield in
column 2 "UnitPrice" formatted as currency and set to caclulate on exit, a
text formfield in column 3 "Qty" formatted as a number and set to calculate
on exit, and a calculation formfield in column 4 "SubTotal" with a formula
=UnitPrice*Qty

The "Qty" is set to run "AddRow" onExit.

The last two rows contain a "sales tax:" calculation and a total
calculation.

Here is the AddRow macro which includes a subroutine to reconstruct the
calculation fields (provided by Tony Jollans). The line that is confussing
me is marked with a long string of
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

Without this line the last calculation isn't updated when the macro
finishes. It will only be updated after the User tabs out of the newly
added UnitPrice field.

It seems to me that pTable.Range.Fields.Update should work just as well as
ActiveDocument.Fields.Update but it doesn't.

Thanks for any ideas or solutions.

Sub AddRow()
Dim pTable As Word.Table
Dim curCursor As Long
Dim bCalcField As Boolean
Dim oRng1 As Word.Range
Dim oRng2 As Word.Range
Dim rowAdd As Long
Dim oFF As Word.FormField
Dim oRowID As Long
Dim i As Long
Dim pNewName As String
Dim pNameSeparator As Long
Dim pRowIndex
Dim oBmName As String
Set pTable = Selection.Tables(1)
If MsgBox("Do you want to add a row?", vbQuestion + vbYesNo, "Add Rows") =
vbNo Then Exit Sub
'Minimize screen flicker
curCursor = System.Cursor
System.Cursor = wdCursorWait
Application.ScreenUpdating = False
'Determine if calculation fields are present and set a flag
On Error GoTo Err_Handler
Set oRng1 = pTable.Rows(pTable.Rows.Count - 2).Range '2 accounts for the
trailing rows
bCalcField = False
For i = 1 To oRng1.FormFields.Count
If oRng1.FormFields(i).TextInput.Type = wdCalculationText Then
bCalcField = True
Exit For
End If
Next i
'Unprotect document.
If ActiveDocument.ProtectionType = wdAllowOnlyFormFields Then
ActiveDocument.Unprotect
End If
Set oRng1 = pTable.Rows(pTable.Rows.Count - 2).Range '2 accounts for the
trailing rows
Set oRng2 = oRng1.Duplicate
With oRng1
.Copy
.Collapse Direction:=wdCollapseEnd
.Paste
End With
For i = 1 To oRng1.FormFields.Count
oRowID = pTable.Rows.Count - 4 '4 accounts for the two leading and two
trailing rows.
'Build and assign formfield bookmark names
oRng1.FormFields(i).Select
'Build new name
pNewName = oRng2.FormFields(i).Name
pNameSeparator = InStr(pNewName, "_Row")
If pNameSeparator > 0 Then
pNewName = Left(pNewName, pNameSeparator - 1)
End If
'Prevent assigning an existing bookmark name
If ActiveDocument.Bookmarks.Exists(pNewName & "_Row" & oRowID) Then
MsgBox "Invalid action. A form field with the bookmark name " _
& pNewName & "_" & oRowID _
& " already appears this table. Exiting this procedure."
pTable.Rows(oRowID).Delete
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
Exit Sub
End If
With Dialogs(wdDialogFormFieldOptions)
.Name = pNewName & "_Row" & oRowID
'Assign valid bookmark name to new formfield
.Execute
End With
Next
'Call subroutine to build new calculation field
If bCalcField Then
BuildNewCalcFieldExpressions oRng1, oRng2
End If
pRowIndex = pTable.Rows.Count - 2 '2 accounts for the 2 trailing rows
oBmName = pTable.Rows(pRowIndex).Cells(1).Range.Bookmarks(1).Name
ActiveDocument.Bookmarks(oBmName).Range.Fields(1).Result.Select
'Delete add row field from previous last row.
Set oRng1 = pTable.Rows(pTable.Rows.Count - 3).Range
oRng1.FormFields(oRng1.FormFields.Count - 1).ExitMacro = ""
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
ActiveDocument.Fields.Update
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'Restore visuals
Application.ScreenUpdating = True
System.Cursor = curCursor
Exit Sub
Err_Handler:
If Err.Number = 5991 Then
MsgBox Err.Description
Else
MsgBox "Unknown error."
End If
End Sub
Sub BuildNewCalcFieldExpressions(ByVal oRng1 As Range, oRng2 As Range)
'Construct any new calculation fields. Credit for this section goes to
fellow MVP Tony Jollans
Dim oFF As FormField
Dim strOldVar As String
Dim strNewVar As String
Dim strNewCalc As String
Dim ndx As Long
Dim ndx2 As Long
Dim lngVarPosit As Long
Dim lngVarNextPosit As Long
Dim bVariableFound As Boolean
Dim bVariableReplace As Boolean
For ndx = 1 To oRng1.FormFields.Count
Set oFF = oRng1.FormFields(ndx)
If oFF.Type = wdFieldFormTextInput Then
If oFF.TextInput.Type = wdCalculationText Then
strNewCalc = oFF.TextInput.Default
For ndx2 = 1 To oRng2.FormFields.Count
strOldVar = oRng2.FormFields(ndx2).Name
lngVarPosit = 1
Do While lngVarPosit > 0
lngVarPosit = InStr(lngVarPosit, strNewCalc, strOldVar)
bVariableFound = lngVarPosit > 0
bVariableReplace = bVariableFound
If bVariableReplace Then
If lngVarPosit > 1 Then
If Mid$(strNewCalc, lngVarPosit - 1) Like "[0-9A-Z_a-z]" Then
bVariableReplace = False
End If
End If
End If
If bVariableReplace Then
lngVarNextPosit = lngVarPosit + Len(strOldVar)
If lngVarNextPosit <= Len(strNewCalc) Then
If Mid$(strNewCalc, lngVarNextPosit) Like "[0-9A-Z_a-z]" Then
bVariableReplace = False
End If
End If
End If
If bVariableReplace Then
strNewVar = oRng1.FormFields(ndx2).Name
strNewCalc = Left$(strNewCalc, lngVarPosit - 1) & strNewVar &
Mid$(strNewCalc, lngVarNextPosit)
lngVarPosit = lngVarPosit + Len(strNewVar)
Else
If bVariableFound Then
lngVarPosit = lngVarPosit + Len(strOldVar)
End If
End If
Loop
Next ndx2
oFF.Select
With Dialogs(wdDialogFormFieldOptions)
.TextDefault = strNewCalc
.Execute
End With
End If
End If
Next ndx
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top