運行RDVBA測驗后，Excel在退出時掛起

以下示例包含三個 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

測驗環境2：
主機產品：Microsoft Office 2016 x64
主機版本：16.0.4266.1001
主機可執行檔案：EXCEL.EXE

ModuleTests.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

類1.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

uj5u.com熱心網友回復：

您在 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

然后在我運行測驗后，我在立即視窗中得到這個：

大約 7 秒后，我得到了最后一行：

這向我表明，Assert.IsNotNothing保持參考的時間比它應該的要長。

編輯 #1

洗掉該Clear方法并將 Class2 的 Terminate 事件更改為：

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

似乎也解決了這個問題。唯一的區別是，正如預期的那樣，現在兩個課程都被延遲了。因此，延遲本身似乎不是問題。

uj5u.com熱心網友回復：

我修改了原始代碼并運行了一些更多的實驗，暴露了一些奇怪的行為，如下圖所示。雖然問題的性質仍不清楚并且似乎與 RDVBA 相關（我認為我現在有足夠的證據來創建 RDVBA 問題），但我已經縮小了問題的范圍并找到了解決方法。

簡而言之，我最初進行了這個測驗Assert.IsNotNothing dbm，并且使用檢測代碼，我觀察到了奇怪的終止時間/序列。修改后的代碼包括用于說明目的的條件編譯結構。當Assert.IsTrue Not dbm Is Nothing改為選擇構造時，癥狀和問題都消失了。

標籤：擅长 vba 橡皮鸭

上一篇：在更大的資料集中搜索和查找值的快速方法-VBA

下一篇：如何讀取tableview中選定行的背景顏色？