如何在VBA中为类模块声明静态变量?

时间:2017-05-11 08:10:26

标签: excel vba excel-vba class oop

我想跟踪Excel-VBA中特定类的所有实例,比如VB.Net中的静态成员。所以这是我的课程模块:

ClassModule:clsClass

Private pName as String
'Static pCount Commented as it doesnt work

Property Set Name(arg as String)
    pName=arg
End Property

Private Sub Class_Initialize()
    'pCount = pCount + 1  Commented as it doesnt work 
End Sub

Public Function GetCount()
    GetCount = pCount
End Function

和我的通用模块 模块:Module1

Sub ABC()

Dim instance1 As New clsClass
Dim instance2 As New clsClass
Dim instance3 As New clsClass
Dim instance4 As New clsClass
'Debug.Print instance4.GetCount() This Should Return 4, but doesnt
End Sub

我做错了什么?如何声明在所有实例中共享的变量?

1 个答案:

答案 0 :(得分:1)

最小代码

基于Class (Static) Methods in VBA中所述的逻辑。

静态属性StaticCountConstructor方法中增加。 Get和Let Property过程(If Singleton Is Nothing Then ... Else ... End If)中提到了支持静态属性的最重要代码。

这里的缺点是它使用End来清除全局/静态变量,以便每次调用2时都打印ABC,但也会清除该变量的所有全局变量。您可能不希望的VBProject。如果未使用End,则每次调用2时,它将打印46ABC,+ 2。请参阅下一章中的解决方法。

模块Module1

Sub ABC()
    Set instance1 = New_clsClass()
    Set instance2 = New_clsClass()
    Debug.Print "Result: " & instance1.StaticCount 'This returns 2
    End ' Reset Global/Static memory to clear "Static Singleton" (and whole VBProject memory)
End Sub

Function New_clsClass() As clsClass
    Set Object = New clsClass
    Static Singleton As clsClass
    If Singleton Is Nothing Then
        Set Singleton = New clsClass
    End If
    Set Object.Singleton = Singleton
    Call Object.Constructor
    Set New_clsClass = Object
End Function

类模块clsClass

Private StaticCount_ As Integer
Private Singleton_ As clsClass

Private Static Property Get Singleton() As Object
    Set Singleton = Singleton_
End Property

Private Property Set Singleton(Object As Object)
    Set Singleton_ = Object
End Property

Public Property Get StaticCount() As Integer
    If Singleton Is Nothing Then
        StaticCount = StaticCount_
    Else
        StaticCount = Singleton.StaticCount
    End If
End Property

Private Property Let StaticCount(value As Integer)
    If Singleton Is Nothing Then
        StaticCount_ = value
    Else
        Singleton.StaticCount = value
    End If
End Property

Public Sub Constructor()
    StaticCount = StaticCount + 1
End Sub

使用最小的代码+控制您重置哪些全局/静态变量的方法,而不是使用End

此解决方案基于保留单例的全局变量,因此您可以在运行ABC时重置单例。在这里,除了类clsClass74clsClass75之外的所有单例都将重置,这些类将始终保持其静态属性活动。

模块Module1

Global goSingletons As New Collection

Sub ABC()
    Call ResetGlobalMemory
    Set instance1 = New_clsClass()
    Set instance2 = New_clsClass()
    Debug.Print "Result: " & instance1.StaticCount 'This returns 2
End Sub

Sub ResetGlobalMemory()
    ' Reset all singletons except the one of clsClass7
    For i = goSingletons.count To 1 Step -1
        Select Case TypeName(goSingletons(i))
            Case "clsClass74", "clsClass75"
            Case Else
                Call goSingletons.Remove(i)
        End Select
    Next
End Sub

Function New_clsClass() As clsClass
    Set Object = New clsClass
    Set Object.Singleton = GetSingleton("clsClass")
    Call Object.Constructor
    Set New_clsClass = Object
End Function

Function GetSingleton(ClassName As String)
    On Error Resume Next
    Set Singleton = goSingletons(ClassName)
    If Err.Number <> 0 Then
        On Error GoTo 0
        Select Case ClassName
            Case "clsClass": Set Singleton = New clsClass
            Case "clsClass2": Set Singleton = New clsClass2
            Case Else: Err.Raise 9999, , "Singleton not managed by class " & ClassName
        End Select
        Call goSingletons.Add(Singleton, ClassName)
    End If
    Set GetSingleton = Singleton
End Function

类模块clsClass

Private StaticCount_ As Integer
Private Singleton_ As clsClass

Private Static Property Get Singleton() As Object
    Set Singleton = Singleton_
End Property

Private Property Set Singleton(Object As Object)
    Set Singleton_ = Object
End Property

Public Property Get StaticCount() As Integer
    If Singleton Is Nothing Then
        StaticCount = StaticCount_
    Else
        StaticCount = Singleton.StaticCount
    End If
End Property

Private Property Let StaticCount(value As Integer)
    If Singleton Is Nothing Then
        StaticCount_ = value
    Else
        Singleton.StaticCount = value
    End If
End Property

Public Sub constructor()
    StaticCount = StaticCount + 1
End Sub

最小的代码+构造函数的参数

(建议在此处,以防万一您不确定如何将passing arguments to constructor in VBA的解决方案与上面的代码混合使用)

模块Module1

Sub ABC()
    Set instance1 = New_clsClass(41)
    Set instance2 = New_clsClass(42)
    Debug.Print "Result: " & instance1.StaticCount 'This returns 2
    End ' Reset Global/Static memory to clear "Static Singleton" (and whole VBProject memory)
End Sub

Function New_clsClass(arg1 As Integer) As clsClass
    Set Object = New clsClass
    Static Singleton As clsClass
    If Singleton Is Nothing Then
        Set Singleton = New clsClass
    End If
    Set Object.Singleton = Singleton
    Call Object.Constructor(arg1)
    Set New_clsClass = Object
End Function

类模块clsClass

Private arg1_ As Integer
Private StaticCount_ As Integer
Private Singleton_ As clsClass

Private Static Property Get Singleton() As Object
    Set Singleton = Singleton_
End Property

Private Property Set Singleton(Object As Object)
    Set Singleton_ = Object
End Property

Public Property Get StaticCount() As Integer
    If Singleton Is Nothing Then
        StaticCount = StaticCount_
    Else
        StaticCount = Singleton.StaticCount
    End If
End Property

Private Property Let StaticCount(value As Integer)
    If Singleton Is Nothing Then
        StaticCount_ = value
    Else
        Singleton.StaticCount = value
    End If
End Property

Public Function Constructor(arg1 As Integer)
    arg1_ = arg1
    StaticCount = StaticCount + 1
End Function