在初始化用户表单期间设置列表框（VBA中）的列宽时，Excel崩溃

问题是：每次尝试加载用户表单时，我的MS Excel都会间歇性崩溃。设置列表框的列宽时，MS Excel已停止响应

背景：使用“写入文本文件”样式的记录器，我已成功地将问题缩小到代码的某一部分，在该部分代码中，确实发生了这种情况，但我似乎看不到代码中有任何明显的问题。当我从电子表格上的一个命令按钮初始化一个userform时，这似乎发生了，更具体地说，当我的代码在userform上设置许多列表框的列宽时

守则：

输出：在我的日志中，每次它都会进入下一阶段，然后崩溃，尽管它也不总是崩溃，如果我进入VBA窗口，然后点击按钮，那么它发生的次数会显著减少。不确定这是不是有用的信息

17/11/2015 15:21:45 S***    15:21:45 - Loading form...
17/11/2015 15:21:45 S***    15:21:45 - Variables Set; Creating Tables
17/11/2015 15:21:45 S***    15:21:45 - Creating Table lbSearchTermResultsIPActions

我曾尝试在这里和其他论坛上搜索，但还没有找到任何确定的解决方案。我试过在每个列表框后面放置一个1秒的Application.wait，当然也试过没有所有write-to-log函数的代码，但这两个函数似乎都没有任何效果

更新： 所以我试着先初始化用户表单；按工作表上的按钮打开用户表单-从design（而不是现在的代码）设置列表框，然后在用户表单的第一个选项卡页面上有一个按钮处理初始化代码设置下拉列表的其余部分，用数据填充列表框等。现在，在尝试执行简单循环以填充组合框时，一旦按下第二个按钮，MS Excel就会崩溃

根据Davids的要求添加：

更改链接到组合框的事件：

Private Sub cbField1_Change()

Select Case cbField1.Value

    Case ""
        cbOption1.Clear

    Case "Action_Urgency"
        With cbOption1
            .Clear
            .List = Array("Low", "Mid", "High")
'                .ListIndex = 0
        End With

    Case "Action_Territory"
        cbOption1.Clear
        rsARR = GetUniqueDepts
        For i = LBound(rsARR, 2) To UBound(rsARR, 2)
            cbOption1.AddItem rsARR(0, i)
        Next
        Erase rsARR

    Case "Action_Team"
        cbOption1.Clear
        rsARR = GetUniqueTeams
        For i = LBound(rsARR, 2) To UBound(rsARR, 2)
            cbOption1.AddItem rsARR(0, i)
        Next
        Erase rsARR

    Case "Action_Owner"
        cbOption1.Clear
        rsARR = GetUniqueOwners
        For i = LBound(rsARR, 2) To UBound(rsARR, 2)
            cbOption1.AddItem rsARR(0, i)
        Next
        Erase rsARR

    Case "Action_Due_Date"
        With cbOption1
            .Clear
            .List = Array("Due", "Overdue")
'                .ListIndex = 0
        End With
'            Erase rsARR

    Case "Attorney"
        cbOption1.Clear
        rsARR = GetUniqueAttorneys
        For i = LBound(rsARR, 2) To UBound(rsARR, 2)
            cbOption1.AddItem rsARR(0, i)
        Next
        Erase rsARR

    Case "Action_Status"
        cbOption1.Clear
        rsARR = GetUniqueActions_Required
        For i = LBound(rsARR, 2) To UBound(rsARR, 2)
            cbOption1.AddItem rsARR(0, i)
        Next
        Erase rsARR

    Case "Action_Stage"
        With cbOption1
            .Clear
            .List = Array("Open", "Closed")
'                .ListIndex = 0
        End With

End Select

End Sub

---

我真的不知道这里发生了什么，可能是因为我的用户表单太复杂，MS Excel无法一次处理所有的过程，因为我确实有一些操作是在第一次打开用户表单时运行的？

通过测试大量场景，我发现在工作簿打开时，在运行任何代码之前保存工作簿可以防止我在没有对原始代码进行任何调整的情况下遇到任何excel崩溃

我只是补充说：

Private Sub Workbook_Open()

    ActiveWorkbook.Save

End Sub

使过程自动化

---

注意：希望将此添加为答案，但这更像是一种解决方法，因此我不会将其标记为答案，但是，我认为对于同样遇到此问题并遇到此问题的人来说，发布一个答案可能是有用的。

请尝试先清除每个列表框，然后检查问题是否仍然弹出。我不确定它是否会崩溃，但是分隔符应该是分号而不是逗号，对于最后一个控件，15列有16个宽度。为什么不在设计时设置这些项目？哦，是的。。。尝试设置宽度：。ColumnWidths=25 Pt；50磅；28磅；我唯一能想到的是工作簿本身有一个错误。。。这意味着您需要创建一个新工作簿。。。但是，复制工作表或表单也可能复制错误。。。您需要只创建导致错误的部分form+宏并对其进行多次测试。。。如果没有弹出错误，则复制每个部分并始终在两个部分之间运行测试。隐马尔可夫模型。。。您是否尝试在代码前面使用Application.EnableEvents=False？现在我将删除我的答案，我想不出任何事情，除了工作簿本身有缺陷的可能性。。。当在没有事件的情况下运行代码并在代码的不同部分发生崩溃时，但有时听起来不像是打字错误之类的。。。仍然有可能是另一个进程弄乱了ram或类似的东西，但这也会导致其他错误。。。因此，也可能存在保存损坏数据的数据库连接。。。。我认为这不是一个简单的答案。。。仅保留创建新wb作为测试的选项：/

Private Sub cbField1_Change()

Select Case cbField1.Value

    Case ""
        cbOption1.Clear

    Case "Action_Urgency"
        With cbOption1
            .Clear
            .List = Array("Low", "Mid", "High")
'                .ListIndex = 0
        End With

    Case "Action_Territory"
        cbOption1.Clear
        rsARR = GetUniqueDepts
        For i = LBound(rsARR, 2) To UBound(rsARR, 2)
            cbOption1.AddItem rsARR(0, i)
        Next
        Erase rsARR

    Case "Action_Team"
        cbOption1.Clear
        rsARR = GetUniqueTeams
        For i = LBound(rsARR, 2) To UBound(rsARR, 2)
            cbOption1.AddItem rsARR(0, i)
        Next
        Erase rsARR

    Case "Action_Owner"
        cbOption1.Clear
        rsARR = GetUniqueOwners
        For i = LBound(rsARR, 2) To UBound(rsARR, 2)
            cbOption1.AddItem rsARR(0, i)
        Next
        Erase rsARR

    Case "Action_Due_Date"
        With cbOption1
            .Clear
            .List = Array("Due", "Overdue")
'                .ListIndex = 0
        End With
'            Erase rsARR

    Case "Attorney"
        cbOption1.Clear
        rsARR = GetUniqueAttorneys
        For i = LBound(rsARR, 2) To UBound(rsARR, 2)
            cbOption1.AddItem rsARR(0, i)
        Next
        Erase rsARR

    Case "Action_Status"
        cbOption1.Clear
        rsARR = GetUniqueActions_Required
        For i = LBound(rsARR, 2) To UBound(rsARR, 2)
            cbOption1.AddItem rsARR(0, i)
        Next
        Erase rsARR

    Case "Action_Stage"
        With cbOption1
            .Clear
            .List = Array("Open", "Closed")
'                .ListIndex = 0
        End With

End Select

End Sub

Private Sub Workbook_Open()

    ActiveWorkbook.Save

End Sub