VBA中的Sentry对象

Question

我在网络和我自己的项目中无处不在地看到具有以下模式的代码:

Sub Func()
     Application.EnableEvents = False
     ' some code
     Application.EnableEvents = True
End Sub

由于VBA对象的生命周期似乎是确定性的,我认为我可以像我们所做的那样用所谓的哨兵对象替换这个模式C++,这样就可以自动解决异常退出(err.raise)的问题.

但是怎么样？我不知道,因为我是新手,VBA甚至不知道什么时候通过引用传递对象.理想情况下,我希望代码看起来像这样:

Sub Func()
     dim Sentry
     Set Sentry = CreateSentry(Application.EnableEvents,False)

     ' From now on we should not need to care if the variable was actually 
     ' True or False beforehand, what kind of error handling is used in this function, etc.
End Sub

Answer 1

Application.EnableEvents不是变量,它是属性.你不能在VB(A)中通过这样的引用传递属性,编译器将创建当前属性值的临时副本,并且你的哨兵将在副本上"关闭".

要以这种方式管理对象属性,您可以这样做:
创建一个类,为其命名SentryForPropertiesVariant并使用类似的代码:

Option Explicit

Private m_Obj As Object
Private m_PropertyName As String
Private m_OldValue As Variant


Public Sub Init(ByVal obj As Object, ByVal PropertyName As String, ByVal NewValue As Variant)
  Set m_Obj = obj
  m_PropertyName = PropertyName

  m_OldValue = CallByName(obj, m_PropertyName, VbGet)
  CallByName m_Obj, m_PropertyName, VbLet, NewValue
End Sub

Private Sub Class_Terminate()
  If Not m_Obj Is Nothing Then
    CallByName m_Obj, m_PropertyName, VbLet, m_OldValue
  End If
End Sub

然后使用它:

Dim s As SentryForPropertiesVariant
Set s = New SentryForPropertiesVariant

s.Init Application, "EnableEvents", False

您还可以在模块中使用辅助函数:

Public Function CreateSentry(ByVal obj As Object, ByVal PropertyName As String, ByVal NewValue As Variant) As SentryForPropertiesVariant
  Set CreateSentry = New SentryForPropertiesVariant

  CreateSentry.Init obj, PropertyName, NewValue
End Function

在哪一点使用变得更简单:

Dim s As SentryForPropertiesVariant
Set s = CreateSentry(Application, "EnableEvents", False)

在这种情况下,你可能要替换Public Sub Init用Friend Sub Init.

如果您计划将您的sentry类存储在共享加载项(.xla)中,则无论如何都必须具有此类帮助函数,因为无法通过驻留在其他工作簿中的代码创建加载项中定义的类,因此解决方案是还要在与创建实例的类相同的工作簿中定义函数,并将其返回给外部调用者.

最后,用With(类似于C#using)来控制这些哨兵的生命是很方便的:

With CreateSentry(Application, "EnableEvents", False)
  'Here EnableEvents is False
End With

'Here it's True