Hello
I have what I thought was quite a simple macro that fires on exit from a form control.
When I step through the macro using f8 it works correctly. When it runs uninterrupted it crashes the app. every time.
this is the code
can anyone see what would be causing this?
I have what I thought was quite a simple macro that fires on exit from a form control.
When I step through the macro using f8 it works correctly. When it runs uninterrupted it crashes the app. every time.
this is the code
Code:
Public Sub miscellaneousTableAddRows()
Dim RowCntr As Integer
Dim RowCount As Integer
Dim col1 As String
Dim miscTable As Table
Dim newRow As Row
Dim oRng As Range
Dim oNewRow As Range
Dim oCell As Range
Dim iRow As Long
Dim iCol As Long
Dim CurRow As Long
Dim i As Long
Dim oLastCell As Cell
Set miscTable = ActiveDocument.Tables(4)
Application.ScreenUpdating = False
col1 = miscTable.Cell(RowCount, 1).Range.FormFields(1).Result
If (col1 = "") Then
Exit Sub ' no need to create new row
End If
With miscTable
RowCount = .Rows.Count
iCol = .Columns.Count
Set oRng = .Rows(RowCount).Range
Set oNewRow = .Rows.Last.Range
CurRow = RowCount
End With
dUnlock
oNewRow.Collapse wdCollapseEnd 'Collapse the second range to the end of the table
oNewRow.FormattedText = oRng
For i = 1 To iCol 'Repeat for each column
Set oCell = miscTable.Cell(CurRow, i).Range 'process each cell in the row
With oCell.FormFields(1)
If .DropDown = False Then
If .TextInput.Type = wdNumberText Then
.Result = 0
Else
.Result = ""
End If
End If
If i = iCol Then
.ExitMacro = "miscellaneousTableAddRows"
End If
End With
Next i
For i = 3 To RowCount - 1
miscTable.Cell(i, iCol).Range.FormFields(1).ExitMacro = "doTotals"
Next i
miscTable.Cell(CurRow, 1).Range.FormFields(1).Select
adjustTableFormat (4)
dLock
doTotals
Application.ScreenUpdating = True
End Sub
Sub changeViewPane()
If (ActiveWindow.View.ReadingLayout = True) Then
ActiveWindow.View.ReadingLayout = False 'Not ActiveWindow.View.ReadingLayout
End If
If ActiveWindow.View.SplitSpecial = wdPaneNone Then
If ActiveWindow.View <> wdPrintView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
Else
If ActiveWindow.View <> wdPrintView Then
ActiveWindow.View.Type = wdPrintView
End If
End If
End Sub
Sub dUnlock()
changeViewPane
If ActiveDocument.ProtectionType = wdNoProtection Then
Exit Sub
Else
ActiveDocument.Unprotect Password:=pwd
End If
End Sub
Sub dLock()
changeViewPane
If ActiveDocument.ProtectionType <> wdNoProtection Then
dUnlock
End If
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:=pwd
End Sub
Sub preventAllFurtherEditing()
changeViewPane
ActiveDocument.Protect Password:=pwd, NoReset:=False, Type:= _
wdAllowOnlyReading, UseIRM:=False, EnforceStyleLock:=True
noEditing = True
End Sub
Public Sub doTotals()
If ActiveDocument.Saved = True Then
Exit Sub
End If
Dim RowCntr As Integer
Dim RecurringCharge As Double
Dim nonRecurringCharge As Double
Dim LineTotal As Double
Dim AnnualTotal As Double
Dim QuarterlyTotal As Double
Dim MonthlyTotal As Double
Dim NRTotal As Double
Dim GrandTotal As Double
Dim ChargeType As String
Dim mult As Double
Dim rCount As Integer
Dim tbl As Table
Dim resultsTbl As Table
Dim cdTable As Table
Dim miscTable As Table
Dim initialPeriod As Integer
Dim tmpField As FormField
Dim numCols As Integer
Set tbl = ActiveDocument.Tables(3)
Set resultsTbl = ActiveDocument.Tables(5)
Set cdTable = ActiveDocument.Tables(2)
Set miscTable = ActiveDocument.Tables(4)
rCount = tbl.Rows.Count
numCols = tbl.Columns.Count
NRTotal = MonthlyTotal = QuarterlyTotal = AnnualTotal = GrandTotal = 0
initialPeriod = cdTable.Cell(1, 2).Range.Fields(1).Result
For RowCntr = 3 To rCount
'handle non recurring charges
Set tmpField = tbl.Cell(RowCntr, 6).Range.FormFields(1)
If Len(tmpField.Result) = 0 Then
tmpField.Result = 0
End If
nonRecurringCharge = CDbl(tmpField.Result)
NRTotal = NRTotal + nonRecurringCharge
'handle recurring charges
ChargeType = tbl.Cell(RowCntr, 7).Range.FormFields(1).Result
Set tmpField = tbl.Cell(RowCntr, 8).Range.FormFields(1)
If Len(tmpField.Result) = 0 Then
tmpField.Result = 0
End If
RecurringCharge = tmpField.Result
If (ChargeType = "Monthly") Then
MonthlyTotal = MonthlyTotal + RecurringCharge
mult = 1
ElseIf (ChargeType = "Quarterly") Then
QuarterlyTotal = QuarterlyTotal + RecurringCharge
mult = 1 / 4
ElseIf (ChargeType = "Annual") Then
AnnualTotal = AnnualTotal + RecurringCharge
mult = 1 / 12
End If
LineTotal = mult * RecurringCharge
GrandTotal = GrandTotal + LineTotal
Next RowCntr
rCount = miscTable.Rows.Count
For RowCntr = 3 To rCount
'handle non recurring charges
Set tmpField = miscTable.Cell(RowCntr, 3).Range.FormFields(1)
If Len(tmpField.Result) = 0 Then
tmpField.Result = 0
End If
nonRecurringCharge = CDbl(tmpField.Result)
NRTotal = NRTotal + nonRecurringCharge
'handle recurring charges
ChargeType = miscTable.Cell(RowCntr, 4).Range.FormFields(1).Result
Set tmpField = miscTable.Cell(RowCntr, 5).Range.FormFields(1)
If Len(tmpField.Result) = 0 Then
tmpField.Result = 0
End If
If IsNumeric(tmpField.Result) = False Then
tmpField.Result = 0
End If
RecurringCharge = CDbl(tmpField.Result)
If (ChargeType = "Monthly") Then
MonthlyTotal = MonthlyTotal + RecurringCharge
mult = 1
ElseIf (ChargeType = "Quarterly") Then
QuarterlyTotal = QuarterlyTotal + RecurringCharge
mult = 1 / 4
ElseIf (ChargeType = "Annual") Then
AnnualTotal = AnnualTotal + RecurringCharge
mult = 1 / 12
End If
LineTotal = mult * RecurringCharge
GrandTotal = GrandTotal + LineTotal
Next RowCntr
GoTo ErrorHandler
ErrorHandler:
GrandTotal = (GrandTotal * initialPeriod) + NRTotal
If noEditing <> True Then
dUnlock
inProcess = True
resultsTbl.Cell(1, 3).Range.Text = "£" + FormatNumber(NRTotal)
resultsTbl.Cell(2, 3).Range.Text = "£" + FormatNumber(MonthlyTotal)
resultsTbl.Cell(3, 3).Range.Text = "£" + FormatNumber(QuarterlyTotal)
resultsTbl.Cell(4, 3).Range.Text = "£" + FormatNumber(AnnualTotal)
resultsTbl.Cell(5, 3).Range.Text = "£" + FormatNumber(GrandTotal)
dLock
inProcess = False
End If
End Sub
can anyone see what would be causing this?