Question

问题：每当我尝试加载用户表单时，我的MS Excel会间歇性地崩溃（＆＃34; MS Excel已停止响应＆＃34;），特别是在设置列表框的列宽时。< / p>

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

守则：

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。

根据Davids请求添加：

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

使流程自动化。

注意：想要添加这个作为答案，虽然它更像是一种解决方法，所以我不会将其标记为答案，但认为发布作为答案的人也可能有用这个问题并遇到了这个问题。

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

1 个答案: