如果在事件期间鼠标光标移出列表框，Excel 将在 ListBox_DblClick 后冻结

Question

背景

我正在使用 Excel 用户表单（在 .xlam AddIn 内）上的

Listbox_DblClick

事件来执行一系列操作（主要更新用户表单，但几乎执行一些外部日志记录...）。这些操作最多可能需要几秒钟。

问题

如果用户在 ListBox_DblClick 事件期间将鼠标光标移到列表框之外，Excel winbdows 几乎会冻结。

后果

我无法单击 UserForm 或 ActiveSheet 或 VBA 窗口上的任何位置。连Excel的关闭按钮都没有反应。但似乎没有任何东西在运行（事件的最后一行已经运行，CPU 上没有任何可见的东西......）

为了能够再次与 Excel 交互，我需要：

• 暂时将鼠标光标移回到列表框上
• 或临时更改当前的 Windows 应用程序（例如按 Alt+Tab 两次）。

Excel 在全球范围内都很好。没有任何其他后果，冻结后一切运行正常。

我已经检查过的内容

• 这与

  EnableEvents

  或

  ScreenUpdating

  问题无关。这些由宏正确管理。即使在事件结束时添加两行将其设置为 True 也无法解决问题。

• 并不是说宏仍在运行。在事件末尾添加

  Debug.Print "Finished"

  显示“已完成”正常打印，而 Excel 保持冻结状态。

• 由于我不希望用户在当前事件仍在运行时启动新事件，因此我通过使用

  ListBox.Locked

  锁定/解锁许多 ListBox（包括与事件相关的列表框）来防止这种情况事件的开始/结束。但评论这些行并不能解决问题。

最小可重现示例

• 在用户窗体上添加数组
• 添加以下代码

    Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
        For n = 1 To 3000
            Me.Caption = n
        Next n
        Me.ListBox1.List = Array("Apple")
    End Sub

    Private Sub UserForm_Initialize()
        Me.ListBox1.List = Array("Apple", "Banana")
    End Sub

• 双击“香蕉”并移动鼠标光标

注意

在 this post form 2012（在 Dblclick 事件中编辑列表框项目会冻结 Excel，除非鼠标移到列表框上），用户似乎遇到了类似的问题。

Answer 1

正如您发送的链接中提到的，问题出在执行 listbox.rowsource="" 时的 rowsource 然后重新填写 listbox.rowsource="Table_TYPES" 我找到了两个解决方案： 1 您可以操纵鼠标所在的位置 2 创建一个不使用行源的列表框填充器，这里是 VBA Excel 的代码

1：

Private Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare PtrSafe Function GetCursorPos Lib "user32" (ByRef lpPoint As POINTAPI) As Long

Private Type POINTAPI
    x As Long
    y As Long
End Type

ListBox1_DblClick（ByVal 取消为 MSForms.ReturnBoolean）

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim pt As POINTAPI
GetCursorPos pt
SetCursorPos Me.ListBox1.Left + Me.Left + 30, Me.ListBox1.Top + Me.Top + 30
...
SetCursorPos pt.x, pt.y
End Sub

2：

Sub filler(Nom_Tabla As String, Box As MSForms.ListBox)
Dim tbl As ListObject
Dim rng As Range
Dim row As Range
Dim Item As Variant

' Definiciones
Set tbl = ThisWorkbook.Sheets(HOJATIPOS).ListObjects(Nom_Tabla)
Set rng = tbl.DataBodyRange

Box.Clear

If Not rng Is Nothing Then
    For Each row In rng.Rows
        ReDim Item(1 To row.Columns.Count)
        Dim i As Integer
        For i = 1 To row.Columns.Count
            Item(i) = row.Cells(1, i).Value
        Next i
        Box.AddItem
        
        Box.List(Box.ListCount - 1, 0) = Join(Item, "-")
    Next row
End If
End Sub

我希望一些解决方案可以帮助其他人。