2

以下示例包含三个 VBA 模块：两个类和一个常规模块。在我运行 RubberDuck VBA 测试然后尝试关闭 Excel 后，Excel 在主动使用 CPU 时挂起。运行一次测试不会每次都重现这个问题，但是当我至少运行两次时，似乎每次都会重现这个问题。

RDVBA 版本 2.5.2.5871
操作系统：Microsoft Windows NT 6.2.9200.0，x64

测试环境一：
主机产品：Microsoft Office XP x86
主机版本：10.0.6501
主机可执行文件：EXCEL.EXE

测试环境二：
主机产品：Microsoft Office 2016 x64
主机版本：16.0.4266.1001
主机可执行文件：EXCEL.EXE

模块测试.bas

'@TestModule
Option Explicit
Option Private Module

Private Assert As Rubberduck.PermissiveAssertClass

#Const USE_ASSERT_OBJECT = True

'@ModuleInitialize
Private Sub ModuleInitialize()
    Set Assert = New Rubberduck.PermissiveAssertClass
End Sub

'@ModuleCleanup
Private Sub ModuleCleanup()
    Set Assert = Nothing
    Debug.Print CStr(Timer()) & ": Assert = Nothing"
End Sub

'@TestMethod("Factory")
Private Sub ztcCreate_VerifiesDefaultManager()
    Dim dbm As Class2
    Set dbm = Class2.Create(ThisWorkbook.Path)
    #If USE_ASSERT_OBJECT Then
        Assert.IsNotNothing dbm
    #Else
        Assert.IsTrue Not dbm Is Nothing
    #End If
End Sub

Class1.cls

'@PredeclaredId
Option Explicit

Public Function Create(Optional ByVal DefaultPath As String = vbNullString) As Class1
    Dim Instance As Class1
    Set Instance = New Class1
    Set Create = Instance
End Function

Private Sub Class_Terminate()
    Debug.Print CStr(Timer()) & ": Class1 Class_Terminate"
End Sub

Class2.cls

'@PredeclaredId
Option Explicit

Private Type TClass2
    DllMan As Class1
End Type
Private this As TClass2

'@DefaultMember
Public Function Create(ByVal DllPath As String) As Class2
    Dim Instance As Class2
    Set Instance = New Class2
    Instance.Init DllPath
    Set Create = Instance
End Function

Friend Sub Init(ByVal DllPath As String)
    Dim FileNames As Variant
    Set this.DllMan = Class1.Create(DllPath)
End Sub

Private Sub Class_Terminate()
    Debug.Print CStr(Timer()) & ": Class2 Class_Terminate"
End Sub
4

2 回答 2

2

当 Excel 挂起时，您看到的闪烁基本上是 Excel 试图从内存中清除对象但失败。Nothing我肯定知道这一点，因为如果在用户表单内部有一个在表单卸载之前没有设置为的私有自定义类，也会发生同样的事情。

如果您将此代码添加到您的Class2：

Friend Sub Clear()
    Set this.DllMan = Nothing
End Sub

然后更新这个：

Assert.IsNotNothing dbm

对此：

Assert.IsNotNothing dbm
dbm.Clear

在测试方法中，问题就消失了。

此外，如果我更新测试方法：

'@TestMethod("Factory")
Private Sub ztcCreate_VerifiesDefaultManager()
    Dim dbm As Class2
    Set dbm = Class2.Create(ThisWorkbook.Path)
    #If USE_ASSERT_OBJECT Then
        Assert.IsNotNothing dbm
        Debug.Print "Before Clear"
        dbm.Clear
        Debug.Print "After Clear"
    #Else
        Assert.IsTrue Not dbm Is Nothing
    #End If
    Debug.Print "After Test"
End Sub

然后在我运行测试后，我在立即窗口中得到了这个：
图像1

大约 7 秒后，我得到了最后一行：
图2

这向我表明，Assert.IsNotNothing持有参考的时间比它应该的要长。

编辑#1

删除该Clear方法并将 Class2 的 Terminate 事件更改为：

Private Sub Class_Terminate()
    Set this.DllMan = Nothing
    Debug.Print CStr(Timer()) & ": Class2 Class_Terminate"
End Sub

似乎也解决了这个问题。唯一的区别是现在两个课程都按预期延迟了。因此，延迟本身似乎不是问题。

于 2021-11-25T10:53:58.963 回答
1

我已经修改了原始代码并进行了一些实验，暴露了一些奇怪的行为，如下图所示。虽然问题的性质仍不清楚并且似乎与 RDVBA 相关（我认为我现在有足够的证据来创建 RDVBA 问题），但我已经缩小了问题范围并找到了解决方法。

简而言之，我最初有这个测试Assert.IsNotNothing dbm，并且使用检测代码，我观察到奇怪的终止时间/序列。修改后的代码包括一个用于说明目的的条件编译结构。选择构造时Assert.IsTrue Not dbm Is Nothing，症状和问题都消失了。

于 2021-11-25T10:11:31.727 回答