Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Macro crashes Word when run but not when stepped through.

Status
Not open for further replies.

jpadie

Technical User
Nov 24, 2003
10,094
FR
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

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?


 
One way to find out where you have a problem is to write some basic information into a text file.

Code:
[blue]
Open "C:\Test\MyLog.txt" For Append As #1"
Print #1, "Step 1"
Close #1[/blue]

    col1 = miscTable.Cell(RowCount, 1).Range.FormFields(1).Result
    If (col1 = "") Then
        Exit Sub ' no need to create new row
    End If
[blue]
Open "C:\Test\MyLog.txt" For Append As #1"
Print #1, "Step 2"
Close #1[/blue]
    
    With miscTable
        RowCount = .Rows.Count
        iCol = .Columns.Count
        Set oRng = .Rows(RowCount).Range
        Set oNewRow = .Rows.Last.Range
        CurRow = RowCount
    End With
...

And then - after you crash - open the MyLog.txt file from C:\Test and see what was the last Step you recorded. Somewhere after that Step and before the next one you have a problem in your code.

Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.
 
Can you elucidate as to why code would work in stepthru and not in run mode?
 
From my experience, sometimes stepping thru the code gives your computer enough time to accomplish certain tasks, but when you ‘run’ - some tasks don’t have enough time to do their jobs.

And other times there is no good explanation why it happens.

You may also ask the question: “Why –when automate Office products from ‘outside’, like Excel from VB6 - some code runs just fine first time around, and complains/crashes on the second time?” :)

But I would try to point to a line of code (or maybe a few lines of code) that is/are the problem and post it here. I am sure people at TT will be able to help you.


Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.
 
And there's the difficulty. I cannot see anything that could cause a problem. And indeed when slowed down there is no problem.

Thanks anyway - I have sent the document back to its owner.
 
I'd suggest getting rid of the changeViewPane sub and the calls to it. It's not doing anything particularly useful and the view switching may be causing timing issues.

Cheers
Paul Edstein
[MS MVP - Word]
 
Thanks macropod.

I had understood from the ms website that it was necessary for the protection scheme although I have not tested all scenarios in its absence. The sub is conditionalised so that for most people (or at least lawyers, who work in print view) it will never do anything other than pass through.

Annoyingly the code works OK (with minimal modifications) on the latest version of word; albeit by installation is on a much faster laptop than the corporate standard issue. I think I will shove error handling in and a judicious sleep or two.

I footprinted the code and it worked fine. So that is suggestive of a race condition. Perhaps the add of the row and populating the fields are not fully synchronous operations.

 
There's also a possiblility that the document has a corrupted character in it somewhere. I had an excel file with a macro that would crash excel and it ended up that a cell somewhere in the spreadsheet was corrupt. I copied all of the information I needed from the spreadsheet into a new spreadsheet and the macro ran without giving any errors.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top