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

Excel macro inconsistently causes Excel to "stop working"

提问by Adam N

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.

我正在运行 Excel 2013 并且我最近开发的一个宏不一致（万岁！）导致 Excel 冻结，给我“Excel 已停止工作”错误。简而言之，宏会提示用户提供有关他们想要做什么的一些基本信息，然后创建许多新工作表（基于模板工作表）并使用摘要选项卡中的信息行填充每个工作表（用户填写）在启动宏之前）。当我运行宏时，它会在我完成提示后立即冻结。我可以立即重新启动工作簿，使用相同的输入再次运行宏，它将起作用。所以很难复制这个问题，也很难诊断和修复它。

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.

我已经尝试了很多方法来解决这个问题（更改 Shift:=xl--- 对 xlShift 的调用；将选项卡从分页预览更改为普通视图；将宏按钮移动到另一个工作表），但它仍然冻结。最近的尝试（似乎工作了一段时间）是将用于启动宏的表单控件按钮更改为 ActiveX 控件按钮（位于摘要选项卡上）。我尝试设置一个基本的错误处理程序，但是当我让它再次冻结时没有找到任何东西。我试过单步执行代码，当它冻结时，是在第一次执行 selection.insert 调用之后。

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).

关于可能会发生什么以及我可以尝试解决什么问题的任何想法？我唯一没有完全测试过的是在 .Insert 行之后插入 Application.Wait Now + (TimeValue("00:00:01") ；另一位用户说这对他们有用（在更新 #4时刻：找到了！这是链接。），尽管情况略有不同。此外，该行可以在一次执行宏时运行数百次，因此每次等待一秒钟是非常繁重的（我还没有尝试使用几分之一秒，我也不确定等待多短仍然会产生预期的效果）。

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 believeit has ever frozen on the second or third or... time running the macro.

更新 #1：我忘记了这个花絮。当它冻结时，它似乎总是在我打开工作簿后第一次运行宏时。我不相信它会在运行宏的第二次、第三次或...时间冻结。

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.

更新 #2：在为 yr_temp 和 task_counter 添加 debug.print 调用（感谢 Alex Bell 的建议）并多次运行宏之后，我终于在观看即时窗口时让它冻结在我身上。同样，它似乎在第一次调用异常麻烦的 sheet.insert 行后崩溃了。更重要的是，yr_temp 和 task_counter 的值与之前每次顺利运行的尝试中的有效数字相同。那么，任何其他想法可能导致这个问题？这个周末我将尝试在另一台计算机上运行它，看看它是否与这个系统有关，而不是宏本身。

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.

更新 #3：我尝试在另一台计算机（运行 Office 2010）上使用该工作簿。到目前为止，我还没有让它冻结，但现在就说它不会在该系统上冻结还为时过早。

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

采纳答案by Adam N

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.

我通过操作中心提取了冻结的错误详细报告，看起来“故障模块”是 mso.dll（至少它在我检查的少数错误报告中）。我发现的最有希望的建议修复是运行 Office 修复（通过控制面板中的程序和功能）。到目前为止，这一直在工作，但我不会称这个问题已经解决，直到我再使用几天而没有崩溃。

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

回答by Alexander Bell

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.

在执行该有问题的行之前分析值的有效性，特别是：行号是否在有效范围内，并且 Sheets(yr_temp) 是否存在。希望这将有助于追踪错误的来源。