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

Question

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

背景：使用写入文本文件样式记录器，我已经设法将问题缩小到发生这种情况的代码部分（当它确实发生时），但我似乎看不到任何明显的问题我的代码。当我从电子表格上的命令按钮初始化用户窗体时，更具体地说，当我的代码设置用户窗体上多个列表框的列宽度时，似乎会发生这种情况。

代码：

Private Sub UserForm_Initialize()

Dim strUserName As String
Dim strUserNameF As String
Dim headerARR() As Variant
Dim i As Integer

logevents (Time() & " - Loading form...")

strUserName = Environ("Username") 'for a more specific user log on number
strUserNameF = Application.UserName 'for a UI friendly log on name

'Set Labels
lblLoggedInAs.Caption = "You are currently logged in as: " & strUserNameF & " (" & strUserName & ")"
lblCurrVersion.Caption = "Current Version: " & strCurrVersion
lblLastUpdated.Caption = "Last Updated: " & strLastUpdated

logevents (Time() & " - Variables Set; Creating Tables")
Application.StatusBar = "Variables Set; Creating Tables"

logevents (Time() & " - Creating Table lbSearchTermResultsIPActions")
With lbSearchTermResultsIPActions
    .ColumnCount = 4
    .ColumnWidths = "25,50,48,150"
End With

logevents (Time() & " - Creating Table lbIPActions")
With lbIPActions
    .ColumnCount = 11
    .ColumnWidths = "40,1,28,72,70,32,53,98,60,70,70"
End With

logevents (Time() & " - Creating Table lbMyActions")
With lbMyActions
    .ColumnCount = 8
    .ColumnWidths = "44,1,47,61,127,60,50,35"
End With

logevents (Time() & " - Creating Table lbOutActions")
With lbOutActions
    .ColumnCount = 8
    .ColumnWidths = "44,1,47,61,127,60,50,35"
End With

logevents (Time() & " - Creating Table lbAllActions")
With lbAllActions
    .ColumnCount = 8
    .ColumnWidths = "44,1,47,61,127,60,50,35"
End With

logevents (Time() & " - Creating Table lbSearchTermResults")
With lbSearchTermResults
    .ColumnCount = 15
    .ColumnWidths = "25,50,50,150,100,70,70,85,50,40,65,40,40,40,40,40"
End With

logevents (Time() & " - Tables Created")
Application.StatusBar = "Tables Created"

输出：在我的日志中，它每次都会进入以下阶段然后崩溃，但同样，它并不总是崩溃，如果我进入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

，当然也尝试了没有所有写入日志功能的代码，但似乎都没有任何效果。

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

根据戴维斯的要求添加：

logevents ("Starting first loop")

For i = 1 To 6
    With Controls("cbField" & i)
        .Clear
        .List = Array("", "Action_Status", "Action_Urgency", "Action_Territory", "Action_Team", "Action_Owner", "Action_Stage", "Action_Due_Date", "Attorney")
        .ListIndex = 0
    End With

Next i

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

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 无法一次处理所有过程，因为我确实有一些操作在第一次打开用户表单时运行？

Answer 1

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

我只是补充：

Private Sub Workbook_Open()

    ActiveWorkbook.Save

End Sub

使流程自动化。

注意：想将其添加为答案，虽然它更多的是一种解决方法，所以我不会将其标记为答案，但认为将其作为答案发布对于也遇到此问题并来的人来说可能很有用穿过这个线程。

Answer 2

我知道这已经很旧了，但这个问题在 macOS 上仍然存在。 上面的解决方法对我不起作用。

所做的工作是在加载列表后设置列宽。 如果没有数据，任何设置宽度的尝试都会使 Excel 完全失效。

在 Windows 下设置列没有问题。