观察者模式:通过 FormControl 关闭用户窗体导致堆栈外 Space 错误
Observer-Pattern: Closing UserForm via FormControl causes Out of stack Space Error
更新:
我的 PC 上的 Visio 和 Excel 似乎不使用相同的 Office 对象库,至少在查看所用参考资料时我是这么认为的。 Visio 使用 15.0,Excel 使用 16.0,我们对两者使用不同的订阅,Excel 是 MS office 365 ProPlus 包的一部分,Visio 是独立的。
我在当前订阅了带有 16.0 Office 对象库的 Visio 的 PC 上对其进行了测试。这次关闭用户窗体并没有导致崩溃。所以我猜问题出在旧版本上。如果有人能够交叉检查并在 Excel 15.0 安装中测试代码,那就太好了。
原版Post
我一直在使用 VBA 中的 Observer 实现来创建一些实现接口的 "better" 用户窗体。
就我而言,该解决方案效果很好,但有一个小问题:
每当我通过按 FormControlMenu 关闭控件(top/right 角中的红色 X)关闭用户窗体时,我的应用程序就会崩溃并显示 "Out of Stack Space Error"。
崩溃以下列方式发生:我收到带有错误的消息框(标准 VBA),当我关闭它时似乎没有任何问题,但是一旦我尝试 运行 另一段代码( any) Visio 将崩溃到桌面。
现在奇怪的是:我实际上捕获了 vbQueryClose 事件,取消了它,运行 我自己的关闭例程只隐藏了用户窗体。以同样的方式(me.hide)通过命令按钮关闭(隐藏)用户窗体时,不会发生错误。
这只发生在 Visio 中,完全相同的代码导致 Excel 中没有 error/crashing!
我希望对整体有更多了解的人Reference/Object/COM-Business可以对此有所了解
代码:
代码也可以作为压缩文件提供(没有 Excel/Visio 文件,只有导出的模块),因此您不必 copy/paste 和创建用户表单:https://www.dropbox.com/s/ziqjv2umcy3co5t/ObserverExample.zip?dl=0
实际的 Observer 实现有点长,但这段代码是最小的可验证示例。
模块 1(模块):
'@Folder("ObserverTest")
Option Explicit
Sub StartTest()
With New Foo
.Test
End With
End Sub
富 (Class):
'@Folder("ObserverTest")
Option Explicit
Private WithEvents myObs As Observer
Private myView As IBar
Public Sub Test()
Set myView = New Bar
Dim myViewAsObservable As IObservable
Set myViewAsObservable = myView
myViewAsObservable.AddObserver myObs
Set myViewAsObservable = Nothing
myView.Show
Debug.Print myView.howClosed
End Sub
Private Sub Class_Initialize()
Set myObs = New Observer
End Sub
Private Sub Class_Terminate()
Set myObs = Nothing
End Sub
Private Sub myObs_Notify(source As Object, arg As Variant)
If VarType(arg) = vbString Then
Debug.Print arg
End If
End Sub
IBar (Class)
'@Folder("ObserverTest")
Option Explicit
Public Sub Show(): End Sub
Public Property Get howClosed() As String: End Property
IObservable(Class)
'@Folder("ObserverTest")
Option Explicit
Public Sub AddObserver(ByVal obs As Observer): End Sub
栏(用户窗体)
'@Folder("ObserverTest")
Option Explicit
Implements IBar
Implements IObservable
Private obsCol As Collection
Private cancelHow As String
'---IBar Stuff
Private Sub IBar_Show()
Me.Show
End Sub
Private Property Get IBar_howClosed() As String
IBar_howClosed = cancelHow
End Property
'--- Closing Stuff
Private Sub btCancel_Click()
cancelHow = "Closed by pressing the >Cancel< Button"
onCancel
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = VbQueryClose.vbFormControlMenu Then
Cancel = True
cancelHow = "Closed by pressing the >X< Control"
onCancel
End If
End Sub
Private Sub onCancel()
Me.hide
End Sub
'---Observer Stuff
Private Sub UserForm_Initialize()
Set obsCol = New Collection
End Sub
Private Sub UserForm_Terminate()
Set obsCol = Nothing
End Sub
Private Sub tbTest_Change()
Notify Me.tbTest.Text
End Sub
Private Sub IObservable_AddObserver(ByVal obs As Observer)
obsCol.Add obs
End Sub
Private Sub Notify(ByVal arg As Variant)
Dim obs As Observer
For Each obs In obsCol
obs.Notify Me, arg
Next obs
End Sub
观察者(Class)
'@Folder("ObserverTest")
Option Explicit
Public Event Notify(source As Object, arg As Variant)
Public Sub Notify(ByVal source As Object, ByVal arg As Variant)
RaiseEvent Notify(source, arg)
End Sub
问题显然出在我使用的 Office 对象库的版本上。使用 16.0(2016) 库而不是 15.0(2013) 为我解决了这个问题。
如果有人有好的解释,post在这里,我会接受它作为答案。
更新:
我的 PC 上的 Visio 和 Excel 似乎不使用相同的 Office 对象库,至少在查看所用参考资料时我是这么认为的。 Visio 使用 15.0,Excel 使用 16.0,我们对两者使用不同的订阅,Excel 是 MS office 365 ProPlus 包的一部分,Visio 是独立的。
我在当前订阅了带有 16.0 Office 对象库的 Visio 的 PC 上对其进行了测试。这次关闭用户窗体并没有导致崩溃。所以我猜问题出在旧版本上。如果有人能够交叉检查并在 Excel 15.0 安装中测试代码,那就太好了。
原版Post
我一直在使用 VBA 中的 Observer 实现来创建一些实现接口的 "better" 用户窗体。 就我而言,该解决方案效果很好,但有一个小问题:
每当我通过按 FormControlMenu 关闭控件(top/right 角中的红色 X)关闭用户窗体时,我的应用程序就会崩溃并显示 "Out of Stack Space Error"。
崩溃以下列方式发生:我收到带有错误的消息框(标准 VBA),当我关闭它时似乎没有任何问题,但是一旦我尝试 运行 另一段代码( any) Visio 将崩溃到桌面。
现在奇怪的是:我实际上捕获了 vbQueryClose 事件,取消了它,运行 我自己的关闭例程只隐藏了用户窗体。以同样的方式(me.hide)通过命令按钮关闭(隐藏)用户窗体时,不会发生错误。
这只发生在 Visio 中,完全相同的代码导致 Excel 中没有 error/crashing!
我希望对整体有更多了解的人Reference/Object/COM-Business可以对此有所了解
代码:
代码也可以作为压缩文件提供(没有 Excel/Visio 文件,只有导出的模块),因此您不必 copy/paste 和创建用户表单:https://www.dropbox.com/s/ziqjv2umcy3co5t/ObserverExample.zip?dl=0
实际的 Observer 实现有点长,但这段代码是最小的可验证示例。
模块 1(模块):
'@Folder("ObserverTest")
Option Explicit
Sub StartTest()
With New Foo
.Test
End With
End Sub
富 (Class):
'@Folder("ObserverTest")
Option Explicit
Private WithEvents myObs As Observer
Private myView As IBar
Public Sub Test()
Set myView = New Bar
Dim myViewAsObservable As IObservable
Set myViewAsObservable = myView
myViewAsObservable.AddObserver myObs
Set myViewAsObservable = Nothing
myView.Show
Debug.Print myView.howClosed
End Sub
Private Sub Class_Initialize()
Set myObs = New Observer
End Sub
Private Sub Class_Terminate()
Set myObs = Nothing
End Sub
Private Sub myObs_Notify(source As Object, arg As Variant)
If VarType(arg) = vbString Then
Debug.Print arg
End If
End Sub
IBar (Class)
'@Folder("ObserverTest")
Option Explicit
Public Sub Show(): End Sub
Public Property Get howClosed() As String: End Property
IObservable(Class)
'@Folder("ObserverTest")
Option Explicit
Public Sub AddObserver(ByVal obs As Observer): End Sub
栏(用户窗体)
'@Folder("ObserverTest")
Option Explicit
Implements IBar
Implements IObservable
Private obsCol As Collection
Private cancelHow As String
'---IBar Stuff
Private Sub IBar_Show()
Me.Show
End Sub
Private Property Get IBar_howClosed() As String
IBar_howClosed = cancelHow
End Property
'--- Closing Stuff
Private Sub btCancel_Click()
cancelHow = "Closed by pressing the >Cancel< Button"
onCancel
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = VbQueryClose.vbFormControlMenu Then
Cancel = True
cancelHow = "Closed by pressing the >X< Control"
onCancel
End If
End Sub
Private Sub onCancel()
Me.hide
End Sub
'---Observer Stuff
Private Sub UserForm_Initialize()
Set obsCol = New Collection
End Sub
Private Sub UserForm_Terminate()
Set obsCol = Nothing
End Sub
Private Sub tbTest_Change()
Notify Me.tbTest.Text
End Sub
Private Sub IObservable_AddObserver(ByVal obs As Observer)
obsCol.Add obs
End Sub
Private Sub Notify(ByVal arg As Variant)
Dim obs As Observer
For Each obs In obsCol
obs.Notify Me, arg
Next obs
End Sub
观察者(Class)
'@Folder("ObserverTest")
Option Explicit
Public Event Notify(source As Object, arg As Variant)
Public Sub Notify(ByVal source As Object, ByVal arg As Variant)
RaiseEvent Notify(source, arg)
End Sub
问题显然出在我使用的 Office 对象库的版本上。使用 16.0(2016) 库而不是 15.0(2013) 为我解决了这个问题。
如果有人有好的解释,post在这里,我会接受它作为答案。