Excel宏不一致导致Excel“停止工作”

Question

I'm running Excel 2013 and a recent macro that I've developed is inconsistently (hooray!) causing Excel to freeze, giving me the "Excel has stopped working" error. In short, the macro prompts the user for some basic info about what they want to do and then creates a number of new sheets (based on a Template sheet) and populates each with rows of info from a Summary tab (which the user fills out before starting the macro). Every now and then when I run the macro, it freezes as soon as I complete the prompts. I can immediately restart the workbook, run the macro again with the same inputs and it will work. So it's hard to replicate the problem, making it hard to diagnosis and fix it.

I've tried a number of things to fix this (changing Shift:=xl--- calls to xlShift---; changing the tabs from Page Break Preview to Normal view; moving the macro button to another sheet), but it still freezes. The latest attempt (which seemed to be working for a while) was to change the Form Control button used to start the macro to an ActiveX Control button (which is housed on the Summary tab). I tried setting up a basic error handler, but that didn't find anything when I got it to freeze again. I've tried stepping through the code and when it froze, it was after executing a selection.insert call the first time.

I've included the full macro below, but the (potential) problem line is:

Sheets(yr_temp).Rows(3 + task_counter).Insert (xlShiftDown)

Any ideas of what might be going on and what else I can try to fix this problem? The only thing I haven't fully tested is to insert Application.Wait Now + (TimeValue("00:00:01") after the .Insert line; another user said this worked for them (can't find the link at the moment UPDATE #4 : Found it! Here's the link .), though it was a slightly different situation. Also, that line can run hundreds of times on a single execution of the macro, so waiting one second each time is pretty burdensome (I haven't tried using a fraction of a second, nor am I sure how short of a wait would still have the desired effect).

UPDATE #1 : I forgot about this tidbit. When it freezes, it seems to always be on the first time I run the macro after opening the workbook. I don't believe it has ever frozen on the second or third or... time running the macro.

UPDATE #2 : After adding debug.print calls for yr_temp and task_counter (thanks for the suggestion, Alex Bell), and running the macro many many times, I finally got it to freeze on me while I watched the Immediate Window. Again, it appeared to have crashed after the first call of the oddly troublesome sheets.insert line. More importantly, the values for yr_temp and task_counter were the same valid numbers from every previous attempt that ran smoothly. So, any other ideas what might be causing this problem? This weekend I will try to run this on another computer to see if it might be something with this system and not the macro itself.

UPDATE #3 : I tried using the workbook on my other computer (running Office 2010). So far I haven't had it freeze, but it's too early for me to claim that it doesn't freeze on that system.

Sub Generate_MM_Sheets()

'' Turn off screen updating for duration of macro (to improve macro speed...and prevent seizures)
Application.ScreenUpdating = False

'' Declare all variables
    Dim valid_resp As Boolean, user_resp As String    '' For user prompts
    Dim yr_start As Integer, yr_num As Integer, yr_counter As Integer, yr_temp As String    '' For year values
    Dim task_num As Integer, task_counter As Integer, task_temp As Integer    '' For task numbers
    Dim sheets_num As Integer, sheet_counter As Integer    '' For sheet numbers
    Dim proj_name As String    '' For project name
    Dim wb_current As String, wb_new As String    '' For workbook names

'' Prompt user to define starting year for the Maintenance Manual sheets
    valid_resp = False
    Do
        user_resp = InputBox("Enter the desired starting year for the Maintenance Manual sheets", , Year(Now()))
        If user_resp = "" Then     '' If the user hits Cancel or returns an empty response, restore screen updating and end the macro
            Application.ScreenUpdating = True
            Exit Sub
        ElseIf Not IsNumeric(user_resp) Then     '' If the response is not a number, warn the user and retry
            MsgBox ("Doh! Invalid entry. The value you entered was not a number.")
        ElseIf Not user_resp = Int(user_resp) Or user_resp <= 0 Then     '' If the response is not a positive integer, warn the user and retry
            MsgBox ("Aw snap! Invalid entry. The value you entered was not a positive integer.")
        Else     '' Otherwise the response is deemed valid. Set the response validity to true and define the macro variable as the user response
            valid_resp = True
            yr_start = user_resp
        End If
    Loop Until valid_resp = True     '' Loop until a valid response is entered

'' Same logic as above, but this time to define the number of years for the Maintenance Manual sheets
    valid_resp = False
    Do
        user_resp = InputBox("Enter the desired total number of years for the Maintenance Manual sheets", , 30)
        If user_resp = "" Then
            Application.ScreenUpdating = True
            Exit Sub
        ElseIf Not IsNumeric(user_resp) Then
            MsgBox ("Come on! Invalid entry. The value you entered was not a number.")
        ElseIf Not user_resp = Int(user_resp) Or user_resp <= 0 Then
            MsgBox ("Bummer, dude! Invalid entry. The value you entered was not a positive integer.")
        Else
            valid_resp = True
            yr_num = user_resp
        End If
    Loop Until valid_resp = True

'' Prompt user to define project name for use in the Maintenance Manual sheet headers
    proj_name = InputBox("Enter the name of the project for the Maintenance Manual sheets")

'' Use the above responses, the data in the Summary tab and the template in the Template tab to create and populate the Maintenance Manual sheets
    task_num = Range(Sheets("Summary").Range("A4"), Sheets("Summary").Range("A4").End(xlDown)).Rows.Count     '' Count the number of Tasks in the Summary tab
    sheets_num = ActiveWorkbook.Sheets.Count     '' Count the current number of sheets in the macro workbook (this value is used when moving the generated sheets to new workbook)
    Sheets("Template").PageSetup.CenterHeader = proj_name & Chr(10) & "Maintenance Items"     '' Update the header of the Template tab to be used on the generated sheets
    For yr_counter = 1 To yr_num     '' Loop through each year
        yr_temp = yr_start + yr_counter - 1     '' Determine the year value for this loop
        Sheets("Template").Copy After:=Sheets(Sheets.Count)     '' Copy the Template tab to the end of the workbook
        Sheets("Template (2)").Name = yr_temp     '' Rename the new tab based on the year value for this loop
        Sheets(yr_temp).Range("A1").Value = Sheets(yr_temp).Range("A1").Value & yr_temp     '' Revise the new tab's description based on the year value for this loop

        task_counter = 0
        For task_temp = 1 To task_num     '' Loop through each task
            task_rem = (yr_counter + Sheets("Summary").Range("E4").Offset(task_temp - 1, 0).Value) Mod _
                    Sheets("Summary").Range("D4").Offset(task_temp - 1, 0).Value     '' Check if the task is due this year (i.e., the year count (plus task age) is a factor of the task frequency)
            If task_rem = 0 Then     '' Then, for each task that is due this year...
                task_counter = task_counter + 1     '' Increment the counter for the number of tasks that have been identified as due this year
                Sheets("Summary").Rows(3 + task_temp).Copy     '' Copy the task from the Summary sheet and insert it at the bottom of the new tab
                Sheets(yr_temp).Rows(3 + task_counter).Insert (xlShiftDown)
            End If
        Next task_temp

        Sheets(yr_temp).Columns("D:E").Delete (xlShiftToLeft)     '' Delete the frequency and current age columns from the new tab
        Sheets(yr_temp).Rows(4 + task_counter).Delete (xlShiftUp)     '' Delete the blank placeholder row (used to preserve formatting and print area) from the new tab
    Next yr_counter

'' Move all of the newly generated Maintenance Manual sheets to a new workbook
    wb_current = ActiveWorkbook.Name     '' Note: This is used in the following code block, but needs to be performed here for simplicity
    Sheets(sheets_num + 1).Select     '' Select the first annual sheet
    For sheet_counter = 2 To yr_num     '' Add each of the remaining annual sheets to the selection
        Sheets(sheets_num + sheet_counter).Select False
    Next sheet_counter
    ActiveWindow.SelectedSheets.Move     '' Move the selected sheets (hopefully all of the newly generated annual sheets) to a new workbook

'' Restore the macro workbook tabs to their original state (for aesthetic/convenience reasons) and then focus back to the newly created workbook
    wb_new = ActiveWorkbook.Name
    Workbooks(wb_current).Sheets("Instructions").Activate
    Workbooks(wb_current).Sheets("Summary").Activate
    Workbooks(wb_current).Sheets("Template").PageSetup.CenterHeader = Chr(10) & "Maintenance Items"     '' Remove project name from Template tab header
    Workbooks(wb_new).Activate

'' Restore screen updating
Application.ScreenUpdating = True

End Sub

Answer 1

I pulled up the error detail reports for the freezes through the Action Center and it looks like the "fault module" is mso.dll (at least it was in the few error reports I checked). The most promising suggested fix that I found was to run a repair of Office (through Programs and Features in the Control Panel). So far this has been working, but I won't call this one solved until I get in a couple more days of use without crashes.

UPDATE: I've been testing it out for a couple days now and still no crashes. I'm marking this as the accepted solution, but will update if the crash comes back. For anyone interest, here is one of the error reports:

**Source**
Microsoft Excel

**Summary**
Stopped working

**Date**
‎12/‎11/‎2014 4:55 PM

**Status**
Report sent

**Description**
Faulting Application Path:  C:\Program Files (x86)\Microsoft Office\Office15\EXCEL.EXE

**Problem signature**
Problem Event Name: APPCRASH
Application Name:   EXCEL.EXE
Application Version:    15.0.4569.1504
Application Timestamp:  52c5e9e1
Fault Module Name:  mso.dll
Fault Module Version:   15.0.4569.1506
Fault Module Timestamp: 52e0c1d0
Exception Code: c0000602
Exception Offset:   0116b30f
OS Version: 6.1.7601.2.1.0.256.4
Locale ID:  1033
Additional Information 1:   6e8a
Additional Information 2:   6e8ae308d57954ab0513d50f2363e5fc
Additional Information 3:   8248
Additional Information 4:   8248af4ab5d8a2564e54f9d6dd7f5d2b

**Extra information about the problem**
Bucket ID:  94371593

Answer 2

Pertinent to your case, it's hard to perform remote debugging without having the actual data. As a general recommendation, apply debugging technique to that problematic statement in you code, like inserting:

' debugging: output to be sent to Immediate Window
Debug.Print task_temp
Debug.Print yr_temp
Debug.Print task_counter

' rest of your code, starting with problematic part
Sheets("Summary").Rows(3 + task_temp).Copy
Sheets(yr_temp).Rows(3 + task_counter).Insert (xlShiftDown)

Analyze the validity of values prior to the execution of that problematic line, in particular: if the row numbers are withing the valid range, and if the Sheets(yr_temp) exists. Hope this will help to trace down the source of the Error.